From 23624f5bdee598191f2ebf2aa55d5f34acae1d45 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Thu, 7 Aug 2025 17:10:57 -0700 Subject: [PATCH 01/49] Add mesh output to OM reader --- optvl/om_wrapper.py | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/optvl/om_wrapper.py b/optvl/om_wrapper.py index b75f217..63837b4 100644 --- a/optvl/om_wrapper.py +++ b/optvl/om_wrapper.py @@ -121,7 +121,18 @@ def add_ovl_geom_vars(self, ovl, add_as="inputs", include_airfoil_geom=False): elif add_as == "outputs": self.add_output(geom_key, val=surf_data[surf][key], tags="geom") +def add_ovl_mesh_out_as_output(self, ovl): + surf_data = ovl.get_surface_params() + + meshes,_ = ovl.get_cp_data() + + for surf in surf_data: + idx_surf = ovl.surface_names.index(surf) + out_name = f"{surf}:mesh" + self.add_output(out_name, val=meshes[idx_surf], tags="geom_mesh") + + def add_ovl_conditions_as_inputs(sys, ovl): # TODO: add all the condition constraints @@ -697,14 +708,18 @@ class OVLMeshReader(om.ExplicitComponent): def initialize(self): self.options.declare("geom_file", types=str) self.options.declare("mass_file", default=None) + self.options.declare("mesh_output",default=False) def setup(self): geom_file = self.options["geom_file"] mass_file = self.options["mass_file"] + mesh_output = self.options["mesh_output"] avl = OVLSolver(geo_file=geom_file, mass_file=mass_file, debug=False) add_ovl_geom_vars(self, avl, add_as="outputs", include_airfoil_geom=True) + if mesh_output: + add_ovl_mesh_out_as_output(self,avl) class Differencer(om.ExplicitComponent): def setup(self): From 3b99ca4c1e397aaaa606c9550353c6944b4a1640 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Fri, 24 Oct 2025 19:14:14 -0400 Subject: [PATCH 02/49] Initial commit of direct mesh setting --- optvl/om_wrapper.py | 4 +- optvl/optvl_class.py | 2 +- src/amake.f | 723 +++++++++++++++++++++++++++++++++++++++++++ src/sgutil.f | 30 +- 4 files changed, 751 insertions(+), 8 deletions(-) diff --git a/optvl/om_wrapper.py b/optvl/om_wrapper.py index 63837b4..5a4d0dd 100644 --- a/optvl/om_wrapper.py +++ b/optvl/om_wrapper.py @@ -130,9 +130,7 @@ def add_ovl_mesh_out_as_output(self, ovl): idx_surf = ovl.surface_names.index(surf) out_name = f"{surf}:mesh" self.add_output(out_name, val=meshes[idx_surf], tags="geom_mesh") - - - + def add_ovl_conditions_as_inputs(sys, ovl): # TODO: add all the condition constraints diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 357772e..7bc0470 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1258,7 +1258,7 @@ def execute_run(self, tol: float = 0.00002): """Run the analysis (equivalent to the AVL command `x` in the OPER menu) Args: - tol: the tolerace of the Newton solver used for timing the aircraft + tol: the tolerace of the Newton solver used for triming the aircraft """ self.set_avl_fort_arr("CASE_R", "EXEC_TOL", tol) self.avl.oper() diff --git a/src/amake.f b/src/amake.f index 8d3fb09..f145cd6 100644 --- a/src/amake.f +++ b/src/amake.f @@ -186,6 +186,8 @@ SUBROUTINE MAKESURF(ISURF) C C----- fudge spacing array to make nodes match up exactly with interior sections DO ISEC = 2, NSEC(ISURF)-1 + ! Throws an error in the case where the same node is the closest node + ! to two consecutive sections IPT1 = IPTLOC(ISEC-1) IPT2 = IPTLOC(ISEC ) IF(IPT1.EQ.IPT2) THEN @@ -637,6 +639,727 @@ SUBROUTINE MAKESURF(ISURF) C RETURN END ! MAKESURF + + subroutine adjust_mesh_spacing(isurf,nx, ny, mesh, iptloc) + ! This routine is a modified standalone version of the "fudging" + ! operation in makesurf. The main purpose is to deal with cases + ! where the user provide a mesh and does not specify the indicies + ! where the sections are nor do they include the number of spanwise + ! elements associated with each section. This routine is intended + ! to be run as a preprocessing step to compute iptloc and the fudged mesh + ! as once we have iptloc makesurf_mesh will know how to handle the sections. + INCLUDE 'AVL.INC' + integer nx, ny, isurf + integer isec, ipt, ipt1, ipt2, idx_sec, idx_pt + integer iptloc(NSEC(isurf)) + real mesh(3,nx,ny) + real ylen(NSEC(isurf)), yzlen(NSEC(isurf)) + real yptloc, yptdel, yp1, yp2, dy, dz, y_mesh, dy_mesh + + + ! Check if the mesh can be adjusted + if (ny < NSEC(isurf)) then + print *, "*** Not enought spanwise nodes to split the mesh" + stop + end if + + ! Unlike the standard fudging routine we have no idea where + ! each section's leading edge is located ahead of time + ! Instead we have to make an initial guess by cutting up + ! the mesh into equal pieces spanwise assuming the wing is flat. + ! We only need to do this is there isn't already a guess for iptloc + + if (iptloc(1) .eq. 0) then + ! compute mesh y length + y_mesh = mesh(2,1,ny) - mesh(2,1,1) + dy_mesh = y_mesh/(NSEC(isurf)-1) + + ! Chop up into equal y length pieces + ylen(1) = 0. + do idx_sec = 2,NSEC(isurf)-1 + ylen(idx_sec) = ylen(idx_sec-1) + dy_mesh + end do + + ! Find node nearest each section + do idx_sec = 2, NSEC(isurf)-1 + yptloc = 1.0E9 + iptloc(idx_sec) = 1 + do idx_pt = 1, ny + yptdel = abs(ylen(idx_sec) - mesh(2,1,idx_pt)) + if(yptdel .LT. yptloc) then + yptloc = yptdel + iptloc(idx_sec) = idx_pt + endif + enddo + enddo + iptloc(1) = 1 + iptloc(NSEC(isurf)) = ny + end if + + + ! Now compute yz arc length using the computed section indicies + yzlen(1) = 0. + do idx_sec = 2, NSEC(isurf) + dy = mesh(2,iptloc(idx_sec), isurf) - mesh(2,(iptloc(idx_sec)-1) + & , isurf) + dz = mesh(3,iptloc(idx_sec), isurf) - mesh(3,(iptloc(idx_sec)-1) + & , isurf) + yzlen(idx_sec) = yzlen(idx_sec-1) + sqrt(dy*dy + dz*dz) + end do + + ! Now do the Drela fudging routine to ensure the sections don't split panels + + ! Find node nearest each section + do isec = 2, NSEC(isurf)-1 + yptloc = 1.0E9 + iptloc(isec) = 1 + do ipt = 1, ny + yptdel = abs(yzlen(isec) - mesh(2,1,ipt)) + if(yptdel .LT. yptloc) then + yptloc = yptdel + iptloc(ISEC) = ipt + endif + enddo + enddo + iptloc(1) = 1 + iptloc(NSEC(ISURF)) = ny + + ! fudge spacing array to make nodes match up exactly with interior sections + do isec = 2, NSEC(isurf)-1 + ! Throws an error in the case where the same node is the closest node + ! to two consecutive sections + ipt1 = iptloc(isec-1) + ipt2 = iptloc(isec ) + if(ipt1.EQ.ipt2) then + CALL STRIP(STITLE(isurf),NST) + WRITE(*,7000) isec, STITLE(isurf)(1:NST) + STOP + end if + + ! fudge spacing to this section so that nodes match up exactly with section + ypt1 = mesh(2,1,ipt1) + yscale = (yzlen(isec)-yzlen(isec-1)) / (mesh(2,1,ipt2) + & -ypt1) + do ipt = ipt1, ipt2-1 + mesh(2,1,ipt) = yzlen(isec-1) + yscale*(mesh(2,1,ipt)-ypt1) + end do + + ! check for unique spacing node for next section, if not we need more nodes + ipt1 = iptloc(isec ) + ipt2 = iptloc(isec+1) + if(ipt1.EQ.ipt2) then + CALL STRIP(STITLE(isurf),NST) + WRITE(*,7000) isec, STITLE(isurf)(1:NST) + STOP + endif + + ! fudge spacing to this section so that nodes match up exactly with section + ypt1 = mesh(2,1,ipt1) + ypt2 = mesh(2,1,ipt2) + yscale = (ypt2-yzlen(isec)) / (ypt2-ypt1) + do ipt = ipt1, ipt2-1 + mesh(2,1,ipt) = yzlen(isec) + yscale*(mesh(2,1,ipt)-ypt1) + enddo + + 7000 format( + & /' *** Cannot adjust spanwise spacing at section', I3, + & ', on surface ', A + & /' *** Insufficient number of spanwise vortices to work with') + enddo + + end subroutine adjust_mesh_spacing + + subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) +c-------------------------------------------------------------- +c Sets up all stuff for surface ISURF, +C using info from configuration input file +C and the given mesh coordinate array. +c-------------------------------------------------------------- + INCLUDE 'AVL.INC' + integer nx, ny + real mesh(3,nx,ny) + real m1, m2, m3, f1, f2, dc1, dc2, dc, a1, a2, a3, xptxind1 + PARAMETER (KCMAX=50, + & KSMAX=500) + real CHSIN, CHCOS, CHSINL, CHSINR, CHCOSL, CHCOSR, AINCL, AINCR, + & CHORDL, CHORDR, CLAFL, CLAFR, SLOPEL, SLOPER, DXDX, ZU_L, + & ZL_L, ZU_R, ZL_R, ZL, ZR, SUM, WTOT, ASTRP + REAL CHSINL_G(NGMAX),CHCOSL_G(NGMAX), + & CHSINR_G(NGMAX),CHCOSR_G(NGMAX) + REAL XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) + INTEGER ISCONL(NDMAX), ISCONR(NDMAX) + integer iptloc(NSEC(isurf)) + integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, idx_y + + ! If the user doesn't input a index vector telling us at what + ! spanwise index each section is located they will have to have + ! provided nspans otherwise they will have to go back and provide + ! iptloc or run adjust_mesh_spacing as a preprocessing step to get + ! a iptloc vector. + if (iptloc(1) .eq. 0) then + ! if NSPANS is given then use it + if (NSPANS(1,isurf) .ne. 0) then + iptloc(1) = 1 + do idx_sec = 2,NSEC(isurf) + iptloc(idx_sec) = iptloc(idx_sec-1) + NSPANS(idx_sec-1,isurf) + end do + else + print *, '* Provide NSPANS or IPTLOC. (Hint: Run adjust_mesh_& + & spacing)' + stop + end if + end if + + + ! Perform input checks from makesurf + + IF(NSEC(ISURF).LT.2) THEN + WRITE(*,*) '*** Need at least 2 sections per surface.' + STOP + ENDIF + + IF(NVC(ISURF).GT.KCMAX) THEN + WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KCMAX to', + & NVC(ISURF) + NVC(ISURF) = KCMAX + ENDIF + + IF(NVS(ISURF).GT.KSMAX) THEN + WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KSMAX to', + & NVS(ISURF) + NVS(ISURF) = KSMAX + ENDIF + + ! Image flag set to indicate section definition direction + ! IMAGS= 1 defines edge 1 located at surface root edge + ! IMAGS=-1 defines edge 2 located at surface root edge (reflected surfaces) + IMAGS(ISURF) = 1 + + ! Start accumulating the element and strip index references + ! Accumulate the first element in surface + if (ISURF == 1) then + IFRST(ISURF) = 1 + else + IFRST(ISURF) = IFRST(ISURF-1) + NK(ISURF-1)*NJ(ISURF-1) + endif + + ! Accumulate the first strip in surface + if (ISURF == 1) then + JFRST(ISURF) = 1 + else + JFRST(ISURF) = JFRST(ISURF-1) + NJ(ISURF-1) + endif + + ! Set NK from input data (python layer will ensure this is consistent) + NK(ISURF) = NVC(ISURF) + + ! We need to start counting strips now since it's a global count + idx_strip = JFRST(ISURF) + + ! Bypass the entire spanwise node generation routine and go straight to store counters + ! Index of first section in surface + IF (ISURF .EQ. 1) THEN + ICNTFRST(ISURF) = 1 + ELSE + ICNTFRST(ISURF) = ICNTFRST(ISURF-1) + NCNTSEC(ISURF-1) + ENDIF + ! Number of sections in surface + NCNTSEC(ISURF) = NSEC(ISURF) + ! Store the spanwise index of each section in each surface + DO ISEC = 1, NSEC(ISURF) + II = ICNTFRST(ISURF) + (ISEC-1) + ICNTSEC(II) = iptloc(ISEC) + ENDDO + + + ! Setup the strips + + ! Set spanwise elements to 0 + NJ(ISURF) = 0 + + ! Check control and design vars (input routine should've already checked this tbh) + IF(NCONTROL.GT.NDMAX) THEN + WRITE(*,*) '*** Too many control variables. Increase NDMAX to', + & NCONTROL + STOP + ENDIF + + IF(NDESIGN.GT.NGMAX) THEN + WRITE(*,*) '*** Too many design variables. Increase NGMAX to', + & NDESIGN + STOP + ENDIF + + + ! Loop over sections + do idx_sec = 1, NSEC(isurf)-1 + + ! Set reference information for the section + iptl = iptloc(idx_sec) + iptr = iptloc(idx_sec+1) + nspan = iptr - iptl + NJ(isurf) = NJ(isurf) + nspan + + + ! We need to compute the chord and claf values at the left and right edge of the section + ! These will be needed by AVL for control surface setup and control point placement + CHORDL = sqrt((mesh(1,nx,iptl)-mesh(1,1,iptl))**2 + + & (mesh(3,nx,iptl)-mesh(3,1,iptl))**2) + CHORDR = sqrt((mesh(1,nx,iptr)-mesh(1,1,iptr))**2 + + & (mesh(3,nx,iptr)-mesh(3,1,iptr))**2) + CLAFL = CLAF(idx_sec, isurf) + CLAFR = CLAF(idx_sec+1,isurf) + + ! Compute the incidence angle at the section end points + ! We will need this later to iterpolate chord projections + AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR + AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR + CHSINL = CHORDL*SIN(AINCL) + CHSINR = CHORDR*SIN(AINCR) + CHCOSL = CHORDL*COS(AINCL) + CHCOSR = CHORDR*COS(AINCR) + + ! We need to determine which controls belong to this section + ! Bring over the routine for this from Drela + DO N = 1, NCONTROL + ISCONL(N) = 0 + ISCONR(N) = 0 + DO ISCON = 1, NSCON(idx_sec,isurf) + IF(ICONTD(ISCON,idx_sec,isurf) .EQ.N) ISCONL(N) = ISCON + ENDDO + DO ISCON = 1, NSCON(idx_sec+1,isurf) + IF(ICONTD(ISCON,idx_sec+1,isurf).EQ.N) ISCONR(N) = ISCON + ENDDO + ENDDO + + ! We need to determine which dvs belong to this section + ! and setup the chord projection gains + ! Bring over the routine for this from Drela + DO N = 1, NDESIGN + CHSINL_G(N) = 0. + CHSINR_G(N) = 0. + CHCOSL_G(N) = 0. + CHCOSR_G(N) = 0. + + DO ISDES = 1, NSDES(idx_surf,isurf) + IF(IDESTD(ISDES,idx_surf,isurf).EQ.N) THEN + CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_surf,isurf)*DTR + CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_surf,isurf)*DTR + ENDIF + ENDDO + + DO ISDES = 1, NSDES(idx_surf+1,isurf) + IF(IDESTD(ISDES,idx_surf+1,isurf).EQ.N) THEN + CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_surf+1,isurf)*DTR + CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_surf+1,isurf)*DTR + ENDIF + ENDDO + ENDDO + + + ! Set the strip geometry data + ! Note these computations assume the mesh is not necessarily planar + ! but will still work correctly for a planar mesh as well + + ! Loop over strips in section + do ispan = 1,nspan + idx_y = iptl + idx_strip - 1 + + ! Strip left side + do idx_dim = 1,3 + RLE1(idx_dim,idx_strip) = mesh(idx_dim,1,idx_y) + end do + CHORD1(idx_strip) = sqrt((mesh(1,nx,idx_y)-mesh(1,1,idx_y))**2 + + &(mesh(3,nx,idx_y)-mesh(3,1,idx_y))**2) + + ! Strip right side + do idx_dim = 1,3 + RLE2(idx_dim,idx_strip) = mesh(idx_dim,1,idx_y+1) + end do + CHORD2(idx_strip) = sqrt((mesh(1,nx,idx_y+1)-mesh(1,1,idx_y+1))**2 + & + (mesh(3,nx,idx_y+1)-mesh(3,1,idx_y+1))**2) + + ! Strip mid-point + do idx_dim = 1,3 + ! Since the strips are linear we can just interpolate + RLE(idx_dim,idx_strip) = (RLE1(idx_dim,idx_strip) + & + RLE2(idx_dim,idx_strip))/2. + ! RLE(idx_dim,idx_strip) = (mesh(idx_dim,1,idx_y+1)+mesh(idx_dim,1,idx_y))/2 + end do + ! Since the strips are linear we can just interpolate + CHORD(idx_strip) = (CHORD1(idx_strip)+CHORD2(idx_strip))/2. +! m1 = ((mesh(1,nx,idx_y+1)+mesh(1,nx,idx_y))/2) - +! & ((mesh(1,1,idx_y+1)+mesh(1,1,idx_y))/2) +! m3 = ((mesh(3,nx,idx_y+1)+mesh(3,nx,idx_y))/2) - +! & ((mesh(3,1,idx_y+1)+mesh(3,1,idx_y))/2) +! CHORD(idx_strip) = sqrt(m1**2 + m3**2) + + ! Strip width (leading edge) + m2 = mesh(2,1,idx_strip+1)-mesh(2,1,idx_strip) + m3 = mesh(3,1,idx_strip+1)-mesh(3,1,idx_strip) + WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) + + ! Strip LE and TE sweep slopes + tanle(idx_strip) = (mesh(1,1,idx_strip+1)-mesh(1,1,idx_strip)) + & /WSTRIP(idx_strip) + tante(idx_strip) = (mesh(1,nx,idx_strip+1)-mesh(1,nx,idx_strip)) + & /WSTRIP(idx_strip) + + ! Compute chord projections and strip twists + ! In AVL the AINCS are not interpolated. The chord projections are + ! So we have to replicate this effect. + + ! Interpolation over the section: left, right, and midpoint + f1 = (mesh(2,1,idx_y)-mesh(2,1,iptl))/ + & (mesh(2,1,iptr)-mesh(2,1,iptl)) + f2 = (mesh(2,1,idx_y+1)-mesh(2,1,iptl))/ + & (mesh(2,1,iptr)-mesh(2,1,iptl)) + fc = (((mesh(2,1,idx_y+1)+mesh(2,1,idx_y))/2.) + & -mesh(2,1,iptl))/(mesh(2,1,iptr)-mesh(2,1,iptl)) + + ! Strip left side incidence + CHSIN = CHSINL + f1*(CHSINR-CHSINL) + CHCOS = CHSINL + f1*(CHCOSR-CHCOSL) + AINC1(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Strip right side incidence + CHSIN = CHSINL + f2*(CHSINR-CHSINL) + CHCOS = CHSINL + f2*(CHCOSR-CHCOSL) + AINC2(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Strip mid-point incidence + CHSIN = CHSINL + fc*(CHSINR-CHSINL) + CHCOS = CHSINL + fc*(CHCOSR-CHCOSL) + AINC(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Set dv gains for incidence angles + ! Bring over the routine for this from Drela + DO N = 1, NDESIGN + CHSIN_G = (1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) + CHCOS_G = (1.0-FC)*CHCOSL_G(N) + FC*CHCOSR_G(N) + AINC_G(idx_strip,N) = (CHCOS*CHSIN_G - CHSIN*CHCOS_G) + & / (CHSIN**2 + CHCOS**2) + ENDDO + + ! We have to now setup any control surfaces we defined for this section + ! Bring over the routine for this from Drela + DO N = 1, NCONTROL + ICL = ISCONL(N) + ICR = ISCONR(N) + + IF(ICL.EQ.0 .OR. ICR.EQ.0) THEN + ! no control effect here + GAINDA(N) = 0. + XLED(N) = 0. + XTED(N) = 0. + + VHINGE(1,idx_strip,N) = 0. + VHINGE(2,idx_strip,N) = 0. + VHINGE(3,idx_strip,N) = 0. + + VREFL(idx_strip,N) = 0. + + PHINGE(1,idx_strip,N) = 0. + PHINGE(2,idx_strip,N) = 0. + PHINGE(3,idx_strip,N) = 0. + + ELSE + ! control variable # N is active here + GAINDA(N) = GAIND(ICL,idx_surf ,isurf)*(1.0-FC) + & + GAIND(ICR,idx_surf+1,isurf)* FC + + XHD = CHORDL*XHINGED(ICL,idx_surf ,isurf)*(1.0-FC) + & + CHORDR*XHINGED(ICR,idx_surf+1,isurf)* FC + IF(XHD.GE.0.0) THEN + ! TE control surface, with hinge at XHD + XLED(N) = XHD + XTED(N) = CHORD(idx_strip) + ELSE + ! LE control surface, with hinge at -XHD + XLED(N) = 0.0 + XTED(N) = -XHD + ENDIF + + VHX = VHINGED(1,ICL,idx_surf,isurf)*XYZSCAL(1,isurf) + VHY = VHINGED(2,ICL,idx_surf,isurf)*XYZSCAL(2,isurf) + VHZ = VHINGED(3,ICL,idx_surf,isurf)*XYZSCAL(3,isurf) + VSQ = VHX**2 + VHY**2 + VHZ**2 + IF(VSQ.EQ.0.0) THEN + ! default: set hinge vector along hingeline + VHX = XYZLES(1,idx_surf+1,isurf) + & + ABS(CHORDR*XHINGED(ICR,idx_surf+1,isurf)) + & - XYZLES(1,idx_surf ,isurf) + & - ABS(CHORDL*XHINGED(ICL,idx_surf,isurf)) + VHY = XYZLES(2,idx_surf+1,isurf) + & - XYZLES(2,idx_surf ,isurf) + VHZ = XYZLES(3,idx_surf+1,isurf) + & - XYZLES(3,idx_surf ,isurf) + VHX = VHX*XYZSCAL(1,isurf) + VHY = VHY*XYZSCAL(2,isurf) + VHZ = VHZ*XYZSCAL(3,isurf) + VSQ = VHX**2 + VHY**2 + VHZ**2 + ENDIF + + VMOD = SQRT(VSQ) + VHINGE(1,idx_strip,N) = VHX/VMOD + VHINGE(2,idx_strip,N) = VHY/VMOD + VHINGE(3,idx_strip,N) = VHZ/VMOD + + VREFL(idx_strip,N) = REFLD(ICL,idx_surf, isurf) + + IF(XHD .GE. 0.0) THEN + PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD + PHINGE(2,idx_strip,N) = RLE(2,idx_strip) + PHINGE(3,idx_strip,N) = RLE(3,idx_strip) + ELSE + PHINGE(1,idx_strip,N) = RLE(1,idx_strip) - XHD + PHINGE(2,idx_strip,N) = RLE(2,idx_strip) + PHINGE(3,idx_strip,N) = RLE(3,idx_strip) + ENDIF + ENDIF + ENDDO + + ! Interpolate CD-CL polar defining data from input sections to strips + DO idx_coef = 1, 6 + CLCD(idx_coef,idx_strip) = (1.0-fc)* + & CLCDSEC(idx_coef,idx_sec,isurf) + + & fc*CLCDSEC(idx_coef,idx_sec+1,isurf) + END DO + ! If the min drag is zero flag the strip as no-viscous data + LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) + + + ! Set the panel (vortex) geometry data + + ! Accumulate the strip element indicies and start counting vorticies + if (idx_strip ==1) then + IJFRST(idx_strip) = 1 + else + IJFRST(idx_strip) = IJFRST(idx_strip - 1) + + & NVSTRP(idx_strip - 1) + endif + idx_vor = IJFRST(idx_strip) + NVSTRP(idx_strip) = NVC(isurf) + + ! Associate each strip with a surface + NSURFS(idx_strip) = isurf + + ! Prepare for cross section interpolation + NSL = NASEC(idx_sec , isurf) + NSR = NASEC(idx_sec+1, isurf) + + ! Interpolate claf over the section + ! CHORDC = CHORD(idx_strip) + clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL + & + FC *(CHORDR/CHORD(idx_strip))*CLAFR + + ! loop over vorticies for the strip + do idx_x = 1, nvc(isurf) + + ! Left bound vortex points + ! Y- point + RV1(2,idx_vor) = mesh(2,idx_x,idx_y) + ! Compute the panel's left side chord and angle + dc1 = sqrt((mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))**2 + & + (mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y))**2) + a1 = atan2((mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y)), + & (mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))) + ! Place vortex at panel quarter chord + RV1(1,idx_vor) = mesh(1,idx_x,idx_y) + (dc1/4.)*cos(a1) + RV1(3,idx_vor) = mesh(3,idx_x,idx_y) + (dc1/4.)*sin(a1) + + ! Right bound vortex points + ! Y- point + RV2(2,idx_vor) = mesh(2,idx_x,idx_y+1) + ! Compute the panel's right side chord and angle + dc2 = sqrt((mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))**2 + & + (mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1))**2) + a2 = atan2((mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1)), + & (mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))) + ! Place vortex at panel quarter chord + RV2(1,idx_vor) = mesh(1,idx_x,idx_y+1) + (dc2/4.)*cos(a2) + RV2(3,idx_vor) = mesh(3,idx_x,idx_y+1) + (dc2/4.)*sin(a2) + + ! Mid-point bound vortex points + ! Y- point + RV(2,idx_vor) = (mesh(2,idx_x,idx_y+1) + mesh(2,idx_x,idx_y))/2. + ! Compute the panel's mid-point chord and angle + ! Panels themselves can never be curved so just interpolate the chord + ! store as the panel chord in common block + DXV(idx_vor) = (dc1+dc2)/2. + ! However compute the mid-point angle straight up since Drela never interpolates angles + a3 = atan2(((mesh(3,idx_x+1,idx_y+1) + mesh(3,idx_x+1,idx_y))/2. + & - (mesh(3,idx_x,idx_y+1) + mesh(3,idx_x,idx_y))/2.), + & ((mesh(1,idx_x+1,idx_y+1) + mesh(1,idx_x+1,idx_y))/2. + & - (mesh(1,idx_x,idx_y+1) + mesh(1,idx_x,idx_y))/2.)) + ! Place vortex at panel quarter chord + RV(1,idx_vor) = (mesh(1,idx_x,idx_y+1)+mesh(1,idx_x,idx_y))/2. + & + (DXV(idx_x)/4.)*cos(a3) + RV(3,idx_vor) = (mesh(3,idx_x,idx_y+1)+mesh(3,idx_x,idx_y))/2. + & + (DXV(idx_x)/4.)*sin(a3) + + + ! Panel Control points + ! Y- point + ! is just the panel midpoint + RC(2,idx_vor) = RV(2,idx_vor) + ! Place the control point at the quarter chord + half chord*clafc + ! note that clafc is a scaler so is 1. for 2pi + ! use data from vortex mid-point computation + RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) + RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) + + ! Source points + ! Y- point + RS(2,idx_vor) = RV(2,idx_vor) + ! Place the source point at the half chord + ! use data from vortex mid-point computation + ! add another quarter chord to the quarter chord + RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) + RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) + + + ! Set the camber slopes for the panel + + ! Camber slope at control point + CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), + & NSL,RC(1,idx_vor)/CHORD(idx_strip),SLOPEL, DSDX) + CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), + & NSR,RC(1,idx_vor)/CHORD(idx_strip),SLOPER, DSDX) + + + SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + + ! Camber slope at vortex mid-point + CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), + & NSL,RV(1,idx_vor)/CHORD(idx_strip),SLOPEL, DSDX) + CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), + & NSR,RV(1,idx_vor)/CHORD(idx_strip),SLOPER, DSDX) + + + SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + + + ! Associate the panel with it's strip's chord and component + CHORDV(idx_vor) = CHORD(idx_strip) + NSURFV(idx_vor) = LSCOMP(isurf) + + ! Enforce no penetration at the control point + LVNC(idx_vor) = .true. + + ! element inherits alpha,beta flag from surface + LVALBE(idx_vor) = LFALBE(isurf) + + ! We need to scale the control surface gains by the fraction + ! of the element on the control surface + do N = 1, NCONTROL + !scale control gain by factor 0..1, (fraction of element on control surface) + FRACLE = (XLED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) + & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / + & (DXV(idx_vor)/CHORD(idx_strip)) + + FRACTE = (XTED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) + & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / + & (DXV(idx_vor)/CHORD(idx_strip)) + + FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) + FRACTE = MIN( 1.0 , MAX( 0.0 , FRACTE ) ) + + DCONTROL(idx_vor,N) = GAINDA(N)*(FRACTE-FRACLE) + end do + + ! TE control point used only if surface sheds a wake + LVNC(idx_vor) = LFWAKE(isurf) + + ! Use the cross sections to generate the OML + ! nodal grid associated with vortex strip (aft-panel nodes) + ! NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; + ! retained in (x,z) plane at this point + + ! Store the panel mid point for the next panel in the strip + ! This gets used a lot here + xptxind1 = ((mesh(1,idx_x,(idx_y+1))-mesh(1,idx_x,idx_y))/2.)/ + & CHORD(idx_strip) + + ! Interpolate cross section on left side + CALL AKIMA( XLASEC(1,idx_sec,isurf), ZLASEC(1,idx_sec,isurf), + & NSL,xptxind1, ZL_L, DSDX ) + CALL AKIMA( XUASEC(1,idx_sec,isurf), ZUASEC(1,idx_sec,isurf), + & NSL,xptxind1, ZU_L, DSDX ) + + ! Interpolate cross section on right side + CALL AKIMA( XLASEC(1,idx_sec+1,isurf),ZLASEC(1,idx_sec+1,isurf), + & NSR, xptxind1, ZL_R, DSDX) + + CALL AKIMA( XUASEC(1,idx_sec+1,isurf), ZUASEC(1,idx_sec+1,isurf), + & NSR, xptxind1, ZU_R, DSDX) + + + ! Compute the left aft node of panel + ! X-point + XYN1(1,idx_vor) = RLE1(1,idx_strip) + + & xptxind1*CHORD1(idx_strip) + + ! Y-point + XYN1(2,idx_vor) = RLE1(2,idx_strip) + + ! Interpolate z from sections to left aft node of panel + ZL = (1.-f1)*ZL_L + f1 *ZL_R + ZU = (1.-f1)*ZU_L + f1 *ZU_R + + ! Store left aft z-point + ZLON1(idx_vor) = RLE1(3,idx_strip) + ZL*CHORD1(idx_strip) + ZUPN1(idx_vor) = RLE1(3,idx_strip) + ZU*CHORD1(idx_strip) + + ! Compute the right aft node of panel + ! X-point + XYN2(1,idx_vor) = RLE2(1,idx_strip) + + & xptxind1*CHORD2(idx_strip) + + ! Y-point + XYN2(2,idx_vor) = RLE2(2,idx_strip) + + ! Interpolate z from sections to right aft node of panel + ZL = (1.-f2)*ZL_L + f2 *ZL_R + ZU = (1.-f2)*ZU_L + f2 *ZU_R + + ! Store right aft z-point + ZLON2(idx_vor) = RLE2(3,idx_strip) + ZL*CHORD2(idx_strip) + ZUPN2(idx_vor) = RLE2(3,idx_strip) + ZU*CHORD2(idx_strip) + + + idx_vor = idx_vor + 1 + end do ! End vortex loop + idx_strip = idx_strip + 1 + end do ! End strip loop + + end do ! End section loop + + ! Compute the wetted area + sum = 0.0 + wtot = 0.0 + DO JJ = 1, NJ(isurf) + J = JFRST(isurf) + JJ-1 + ASTRP = WSTRIP(J)*CHORD(J) + SUM = SUM + ASTRP + WTOT = WTOT + WSTRIP(J) + ENDDO + SSURF(isurf) = SUM + + IF(WTOT .EQ. 0.0) THEN + CAVESURF(isurf) = 0.0 + ELSE + CAVESURF(isurf) = sum/wtot + ENDIF + ! add number of strips to the global count + NSTRIP = NSTRIP + NJ(isurf) + ! add number of of votrices to the global count + NVOR = NVOR + NK(isurf)*NJ(isurf) + + end subroutine makesurf_mesh + subroutine update_surfaces() c-------------------------------------------------------------- diff --git a/src/sgutil.f b/src/sgutil.f index b869f5e..f3d4947 100644 --- a/src/sgutil.f +++ b/src/sgutil.f @@ -296,6 +296,24 @@ SUBROUTINE SPACER (N,PSPACE,X) SUBROUTINE CSPACER(NVC,CSPACE,CLAF, XPT,XVR,XSR,XCP) + ! This is a extremely important funciton that is not + ! documented for some reason. + ! Inputs: + ! NVC: NUMBER OF DESIRED POINTS IN ARRAY + ! CSPACE: SPACING PARAMETER (-3<=PSPACE<=3). + ! DEFINES POINT DISTRIBUTION + ! TO BE USED AS FOLLOWS: + ! PSPACE = 0 : EQUAL SPACING + ! PSPACE = 1 : COSINE SPACING. + ! PSPACE = 2 : SINE SPACING + ! (CONCENTRATING POINTS NEAR 0). + ! PSPACE = 3 : EQUAL SPACING. + ! CLAF: CL alfa (needed to determine control point location) + ! Outputs: + ! XPT: Array of panel x-locations + ! XVR: Array of vortex x-locations + ! XSR: Array of source x-locations + ! XCP: Array of control point x-locations REAL XPT(*), XVR(*), XSR(*), XCP(*) C PI = 4.0*ATAN(1.0) @@ -318,17 +336,21 @@ SUBROUTINE CSPACER(NVC,CSPACE,CLAF, XPT,XVR,XSR,XCP) ENDIF C C---- cosine chordwise spacing + ! Each of these provides a quarter panel chord offset for cosine, + ! sine, and uniform spacing respectively. DTH1 = PI/FLOAT(4*NVC + 2) DTH2 = 0.5*PI/FLOAT(4*NVC + 1) DXC0 = 1.0/FLOAT(4*NVC) C DO IVC = 1, NVC C------ uniform - XC0 = INT(4*IVC - 4) * DXC0 + XC0 = INT(4*IVC - 4) * DXC0 ! eqv (IVC-1)/NVC XPT0 = XC0 - XVR0 = XC0 + DXC0 - XSR0 = XC0 + 2.0*DXC0 - XCP0 = XC0 + DXC0 + 2.0*DXC0*CLAF + XVR0 = XC0 + DXC0 ! quarter-chord + XSR0 = XC0 + 2.0*DXC0 ! half-chord + XCP0 = XC0 + DXC0 + 2.0*DXC0*CLAF ! quarter-chord + half-chord*claf + ! Note: claf is a scaling factor so typically claf = 1 and the control point + ! is at the three-quarter chord position of the panel C C------ cosine TH1 = INT(4*IVC - 3) * DTH1 From bd25ced6536df067ee482e23f1960210054bdbe0 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 27 Oct 2025 17:02:30 -0400 Subject: [PATCH 03/49] Implemented python interface and setting basic meshes works --- optvl/optvl_class.py | 68 +++++++++++++++++++++++++++---- optvl/utils/check_surface_dict.py | 48 +++++++++++++++++++++- src/amake.f | 2 +- src/f2py/libavl.pyf | 12 ++++++ 4 files changed, 120 insertions(+), 10 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 7bc0470..bee18d2 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -728,15 +728,30 @@ def check_type(key, avl_vars, given_val): "scale": np.array([1.,1.,1.]), "translate": np.array([0.,0.,0.]), "angle": 0.0, + "aincs": np.zeros(num_secs, dtype=np.float64), "wake": True, "albe": True, "load": True, "clcd": np.zeros(6, dtype=np.float64), - "nspans": np.zeros(num_secs, dtype=int), - "sspaces": np.zeros(num_secs, dtype=int), + "nspans": np.zeros(num_secs, dtype=np.int32), + "sspaces": np.zeros(num_secs, dtype=np.float64), "clcdsec": np.zeros((num_secs,6)), "claf": np.ones(num_secs), } + + + ignore_if_mesh = { + "xles", + "yles", + "zles", + "chords", + "nchordwise", + "cspace", + "sspaces" + "sspace", + "nspan", + } + # fmt: on # set some flags based on the options used for this surface @@ -762,11 +777,13 @@ def check_type(key, avl_vars, given_val): ): if key not in surf_dict: - if key in optional_surface_defaults: + if (key == "yduplicate") or (("mesh" in surf_dict) and (key in ignore_if_mesh)): + continue + elif key in optional_surface_defaults: val = optional_surface_defaults[key] else: raise ValueError(f"Key {key} not found in surface dictionary, {surf_name}, but is required") - else: + else: val = surf_dict[key] check_type(key, avl_vars, val) @@ -858,9 +875,6 @@ def check_type(key, avl_vars, given_val): self.set_avl_fort_arr("SURF_GEOM_R", "ZLASEC", np.array([0.0, 0.0]), slicer=slicer_airfoil_flat) self.set_avl_fort_arr("SURF_GEOM_R", "ZUASEC", np.array([0.0, 0.0]), slicer=slicer_airfoil_flat) self.set_avl_fort_arr("SURF_GEOM_R", "CASEC", np.array([0.0, 0.0]), slicer=slicer_airfoil_flat) - - - # --- setup control variables for each section --- # Load control surfaces @@ -909,7 +923,14 @@ def check_type(key, avl_vars, given_val): # Make the surface if self.debug: print(f"Building surface: {surf_name}") - self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing + # Load the mesh and make if one is specified otherwise just make + if "mesh" in surf_dict.keys(): + # Check if we have to define the sections for the user + if "iptloc" not in surf_dict.keys(): + surf_dict["iptloc"] = self.avl.adjust_mesh_spacing(idx_surf+1,surf_dict["mesh"].transpose((2, 0, 1)),np.zeros(surf_dict["num_sections"],dtype=np.int32)) + self.set_mesh(idx_surf, surf_dict["mesh"],surf_dict["iptloc"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering + else: + self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing if "yduplicate" in surf_dict.keys(): self.avl.sdupl(idx_surf + 1, surf_dict["yduplicate"], "YDUP") @@ -1023,6 +1044,37 @@ def check_type(key, avl_vars, given_val): # Tell AVL that geometry exists now and is ready for analysis self.avl.CASE_L.LGEO = True + def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_nvs: bool=False, update_nvc: bool=False): + """Sets a mesh directly into OptVL. Requires an iptloc vector to define the indices where the sections are defined. + This is required for many of AVL's features like control surfaces to work properly. OptVL's input routine has multiple + ways of automatically computing this vector. Alternatively, calling the adjust_mesh_spacing subroutine in the Fortran layer + can automatically compute the iptloc vector for a given mesh and number of sections. NOTE: the iptloc input is not differentiated. + Additionally, the length of iptloc cannot change (i.e the number sections cannot change for a surface that's already loaded). + + Args: + idx_surf (int): the surface to apply the mesh to + mesh (np.ndarray): XYZ mesh array (nx,ny,3) + iptloc (np.ndarray): Vector containing the spanwise indicies where each section is defined (num_sections,) + update_nvs (bool): Should OptVL update the number of spanwise elements for the given mesh + update_nvc (bool): Should OptVL update the number of chordwise elements for the given mesh + """ + # idx_surf += 1 + iptloc += 1 #+1 for Fortran indexing + mesh = mesh.transpose((2,0,1)) #reshape for Fortran memory access + + nx = mesh.shape[1] + ny = mesh.shape[2] + + if update_nvs: + self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 + + if update_nvc: + self.avl.SURF_GEOM_I.NVC[idx_surf] = nx-1 + + self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing + + + def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): """Sets the airfoil oml points for the specified surface and section. Computes camber lines, thickness, and oml shape from NACA 4-digit specification. diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index 5784619..5ee618b 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -106,6 +106,9 @@ def pre_check_input_dict(input_dict: dict): "nspans", # number of spanwise elements vector, overriden by nspans "sspaces", # spanwise spacing vector (for each section), overriden by sspace "use surface spacing", # surface spacing set under the surface heeading (known as LSURFSPACING in AVL) + # Geometery: Mesh + "mesh", + "iptloc", # Control Surfaces # "dname" # IMPLEMENT THIS "icontd", # control variable index @@ -193,7 +196,7 @@ def pre_check_input_dict(input_dict: dict): stacklevel=2, ) input_dict[key] = np.sign(input_dict[key]) - + # Check for keys not implemented if key not in keys_implemented_general: warnings.warn( @@ -201,16 +204,59 @@ def pre_check_input_dict(input_dict: dict): category=RuntimeWarning, stacklevel=2, ) + total_global_control = 0 total_global_design_var = 0 if "surfaces" in input_dict.keys(): if len(input_dict["surfaces"]) > 0: for surface in input_dict["surfaces"].keys(): + # Check if we are directly providing a mesh + if "mesh" in input_dict["surfaces"][surface].keys(): + # Check if sections are specified + if "num_sections" in input_dict["surfaces"][surface].keys(): + # Check if the section indices are provided + if "iptloc" in input_dict["surfaces"][surface].keys(): + # If they are make sure we provide one for every section + if len(input_dict["surfaces"][surface]["iptloc"]) != input_dict["num_sections"]: + raise ValueError("iptloc vector length does not match num_sections") + # Check if the user provided nspans instead + elif "nspans" in input_dict["surfaces"][surface].keys(): + # setting iptloc to 0 is how we tell the Fortran layer to use nspans + input_dict["surfaces"][surface]["iptloc"] = np.zeros(input_dict["num_sections"]) + # The OptVL class will have to call the fudging routine to try and auto cut the mesh into sections + else: + warnings.warn( + "Mesh provided for surface dict `{}` for {} sections but locations not defined.\n OptVL will automatically define section locations as close to equally as possible.".format( + surface, input_dict["surfaces"][surface]["num_sections"] + ), + category=RuntimeWarning, + stacklevel=2, + ) + else: + # Assume we have two sections at the ends of mesh and inform the user + warnings.warn( + "Mesh provided for surface dict `{}` but no sections provided.\n Assuming 2 sections at tips.".format( + surface + ), + category=RuntimeWarning, + stacklevel=2, + ) + input_dict["surfaces"][surface]["iptloc"] = np.array([0,input_dict["surfaces"][surface]["mesh"].shape[1]-1],dtype=np.int32) + input_dict["surfaces"][surface]["num_sections"] = 2 + # Verify at least two section if input_dict["surfaces"][surface]["num_sections"] < 2: raise RuntimeError("Must have at least two sections per surface!") + # if no controls are specified then fill it in with 0s + if "num_controls" not in input_dict["surfaces"][surface].keys(): + input_dict["surfaces"][surface]["num_controls"] = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) + + # if no dvs are specified then fill it in with 0s + if "num_design_vars" not in input_dict["surfaces"][surface].keys(): + input_dict["surfaces"][surface]["num_design_vars"] = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) + #Checks to see that at most only one of the options in af_load_ops or one of the options in manual_af_override is selected if len(airfoil_spec_keys & input_dict["surfaces"][surface].keys()) > 1: raise RuntimeError( diff --git a/src/amake.f b/src/amake.f index f145cd6..c33c39f 100644 --- a/src/amake.f +++ b/src/amake.f @@ -640,7 +640,7 @@ SUBROUTINE MAKESURF(ISURF) RETURN END ! MAKESURF - subroutine adjust_mesh_spacing(isurf,nx, ny, mesh, iptloc) + subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) ! This routine is a modified standalone version of the "fudging" ! operation in makesurf. The main purpose is to deal with cases ! where the user provide a mesh and does not specify the indicies diff --git a/src/f2py/libavl.pyf b/src/f2py/libavl.pyf index 8960ffb..f373a79 100644 --- a/src/f2py/libavl.pyf +++ b/src/f2py/libavl.pyf @@ -135,6 +135,18 @@ python module libavl ! in real*8, intent(inout) :: asys(jemax,jemax) end subroutine get_system_matrix + subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) ! in :libavl:amake.f + integer :: isurf, nx, ny + integer :: iptloc(*) + real*8 :: mesh(3,nx,ny) + end subroutine makesurf_mesh + + subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) ! in :libavl:amake.f + integer :: isurf, nx, ny + integer, intent(inout) :: iptloc(*) + real*8 :: mesh(3,nx,ny) + end subroutine adjust_mesh_spacing + !subroutine getcam(x, y, n, xc, yc, tc, nc, lnorm) ! in :libavl:airutil.f !integer, intent(in) :: n !integer, intent(inout) :: nc From 4462a65de672f718f2c8c20848152489afd1962f Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Mon, 27 Oct 2025 22:09:02 -0400 Subject: [PATCH 04/49] minor fixes for adjust_mesh_spacing --- optvl/optvl_class.py | 4 +++- src/amake.f | 11 ++++++----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index bee18d2..f01f48d 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -927,7 +927,9 @@ def check_type(key, avl_vars, given_val): if "mesh" in surf_dict.keys(): # Check if we have to define the sections for the user if "iptloc" not in surf_dict.keys(): - surf_dict["iptloc"] = self.avl.adjust_mesh_spacing(idx_surf+1,surf_dict["mesh"].transpose((2, 0, 1)),np.zeros(surf_dict["num_sections"],dtype=np.int32)) + surf_dict["iptloc"] = np.zeros(surf_dict["num_sections"],dtype=np.int32) + self.avl.adjust_mesh_spacing(idx_surf+1,surf_dict["mesh"].transpose((2, 0, 1)),surf_dict["iptloc"]) + surf_dict["iptloc"] = surf_dict["iptloc"] - 1 self.set_mesh(idx_surf, surf_dict["mesh"],surf_dict["iptloc"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering else: self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing diff --git a/src/amake.f b/src/amake.f index c33c39f..e7fd41d 100644 --- a/src/amake.f +++ b/src/amake.f @@ -700,10 +700,10 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) ! Now compute yz arc length using the computed section indicies yzlen(1) = 0. do idx_sec = 2, NSEC(isurf) - dy = mesh(2,iptloc(idx_sec), isurf) - mesh(2,(iptloc(idx_sec)-1) - & , isurf) - dz = mesh(3,iptloc(idx_sec), isurf) - mesh(3,(iptloc(idx_sec)-1) - & , isurf) + dy = mesh(2,1,iptloc(idx_sec)) - mesh(2,1 + & , (iptloc(idx_sec)-1)) + dz = mesh(3,1,iptloc(idx_sec)) - mesh(3,1 + & , (iptloc(idx_sec)-1)) yzlen(idx_sec) = yzlen(idx_sec-1) + sqrt(dy*dy + dz*dz) end do @@ -789,7 +789,8 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) REAL XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) INTEGER ISCONL(NDMAX), ISCONR(NDMAX) integer iptloc(NSEC(isurf)) - integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, idx_y + integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, + & idx_y ! If the user doesn't input a index vector telling us at what ! spanwise index each section is located they will have to have From 85135d383ba216590c021c4f4070676b642e5160 Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 28 Oct 2025 00:11:44 -0400 Subject: [PATCH 05/49] Fixes for the automatic section slicing routines --- optvl/optvl_class.py | 10 ++++--- src/amake.f | 70 ++++++++++++++++++++++++-------------------- 2 files changed, 45 insertions(+), 35 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index f01f48d..c86297c 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1060,12 +1060,14 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n update_nvs (bool): Should OptVL update the number of spanwise elements for the given mesh update_nvc (bool): Should OptVL update the number of chordwise elements for the given mesh """ + nx = copy.deepcopy(mesh.shape[0]) + ny = copy.deepcopy(mesh.shape[1]) # idx_surf += 1 iptloc += 1 #+1 for Fortran indexing - mesh = mesh.transpose((2,0,1)) #reshape for Fortran memory access - - nx = mesh.shape[1] - ny = mesh.shape[2] + # These seem to mangle the mesh up, just do a simple transpose to the correct ordering + # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0],mesh.shape[1]), order="F") + # iptloc = iptloc.ravel(order="C").reshape(iptloc.shape[::-1], order="F") + mesh = mesh.transpose((2,0,1)) if update_nvs: self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 diff --git a/src/amake.f b/src/amake.f index e7fd41d..7683b3e 100644 --- a/src/amake.f +++ b/src/amake.f @@ -640,7 +640,8 @@ SUBROUTINE MAKESURF(ISURF) RETURN END ! MAKESURF - subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) + subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, + & iptloc) ! This routine is a modified standalone version of the "fudging" ! operation in makesurf. The main purpose is to deal with cases ! where the user provide a mesh and does not specify the indicies @@ -649,14 +650,13 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) ! to be run as a preprocessing step to compute iptloc and the fudged mesh ! as once we have iptloc makesurf_mesh will know how to handle the sections. INCLUDE 'AVL.INC' - integer nx, ny, isurf + integer nx, ny, isurf, niptloc integer isec, ipt, ipt1, ipt2, idx_sec, idx_pt integer iptloc(NSEC(isurf)) real mesh(3,nx,ny) real ylen(NSEC(isurf)), yzlen(NSEC(isurf)) real yptloc, yptdel, yp1, yp2, dy, dz, y_mesh, dy_mesh - ! Check if the mesh can be adjusted if (ny < NSEC(isurf)) then print *, "*** Not enought spanwise nodes to split the mesh" @@ -676,7 +676,7 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) ! Chop up into equal y length pieces ylen(1) = 0. - do idx_sec = 2,NSEC(isurf)-1 + do idx_sec = 2,NSEC(isurf) ylen(idx_sec) = ylen(idx_sec-1) + dy_mesh end do @@ -685,7 +685,7 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) yptloc = 1.0E9 iptloc(idx_sec) = 1 do idx_pt = 1, ny - yptdel = abs(ylen(idx_sec) - mesh(2,1,idx_pt)) + yptdel = abs(mesh(2,1,1)+ ylen(idx_sec) - mesh(2,1,idx_pt)) if(yptdel .LT. yptloc) then yptloc = yptdel iptloc(idx_sec) = idx_pt @@ -696,33 +696,41 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) iptloc(NSEC(isurf)) = ny end if - + ! NOTE-SB: I don't think we need this + ! I originally included it to be more consistent with Drela + ! The prior routine only considers the y distance while + ! Drela considers y and z. However, the above routine appears + ! to work fine on its own and running this after appears to + ! cause issues. + ! Now compute yz arc length using the computed section indicies - yzlen(1) = 0. - do idx_sec = 2, NSEC(isurf) - dy = mesh(2,1,iptloc(idx_sec)) - mesh(2,1 - & , (iptloc(idx_sec)-1)) - dz = mesh(3,1,iptloc(idx_sec)) - mesh(3,1 - & , (iptloc(idx_sec)-1)) - yzlen(idx_sec) = yzlen(idx_sec-1) + sqrt(dy*dy + dz*dz) - end do +! yzlen(1) = 0. +! do idx_sec = 2, NSEC(isurf) +! dy = mesh(2,1,iptloc(idx_sec)) - mesh(2,1 +! & , (iptloc(idx_sec)-1)) +! dz = mesh(3,1,iptloc(idx_sec)) - mesh(3,1 +! & , (iptloc(idx_sec)-1)) +! yzlen(idx_sec) = yzlen(idx_sec-1) + sqrt(dy*dy + dz*dz) +! end do - ! Now do the Drela fudging routine to ensure the sections don't split panels - - ! Find node nearest each section - do isec = 2, NSEC(isurf)-1 - yptloc = 1.0E9 - iptloc(isec) = 1 - do ipt = 1, ny - yptdel = abs(yzlen(isec) - mesh(2,1,ipt)) - if(yptdel .LT. yptloc) then - yptloc = yptdel - iptloc(ISEC) = ipt - endif - enddo - enddo - iptloc(1) = 1 - iptloc(NSEC(ISURF)) = ny +! ! Now do the Drela fudging routine to ensure the sections don't split panels + +! ! Find node nearest each section +! do isec = 2, NSEC(isurf)-1 +! yptloc = 1.0E9 +! iptloc(isec) = 1 +! do ipt = 1, ny +! yptdel = abs(yzlen(isec) - mesh(2,1,ipt)) +! if(yptdel .LT. yptloc) then +! yptloc = yptdel +! iptloc(ISEC) = ipt +! endif +! enddo +! enddo +! iptloc(1) = 1 +! iptloc(NSEC(ISURF)) = ny + +! print *, "Final iptloc", iptloc ! fudge spacing array to make nodes match up exactly with interior sections do isec = 2, NSEC(isurf)-1 @@ -964,7 +972,7 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) ! Loop over strips in section do ispan = 1,nspan - idx_y = iptl + idx_strip - 1 + idx_y = idx_strip - JFRST(isurf) + 1 ! Strip left side do idx_dim = 1,3 From 26820d2450506fc36875a0e375046ec791e58289 Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 28 Oct 2025 01:34:08 -0400 Subject: [PATCH 06/49] Fixes for using nspans to define sections --- optvl/optvl_class.py | 7 +++++-- optvl/utils/check_surface_dict.py | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index c86297c..913dfda 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1062,8 +1062,11 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n """ nx = copy.deepcopy(mesh.shape[0]) ny = copy.deepcopy(mesh.shape[1]) - # idx_surf += 1 - iptloc += 1 #+1 for Fortran indexing + + # Only add +1 for Fortran indexing if we are not explictly telling the routine to use + # nspans by passing in all zeros + if (iptloc != 0).all(): + iptloc += 1 # These seem to mangle the mesh up, just do a simple transpose to the correct ordering # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0],mesh.shape[1]), order="F") # iptloc = iptloc.ravel(order="C").reshape(iptloc.shape[::-1], order="F") diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index 5ee618b..eae087e 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -223,7 +223,7 @@ def pre_check_input_dict(input_dict: dict): # Check if the user provided nspans instead elif "nspans" in input_dict["surfaces"][surface].keys(): # setting iptloc to 0 is how we tell the Fortran layer to use nspans - input_dict["surfaces"][surface]["iptloc"] = np.zeros(input_dict["num_sections"]) + input_dict["surfaces"][surface]["iptloc"] = np.zeros(input_dict["surfaces"][surface]["num_sections"]) # The OptVL class will have to call the fudging routine to try and auto cut the mesh into sections else: warnings.warn( From 83512c4c202200ba149795dc8dfe3ae21b08f576 Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 28 Oct 2025 03:30:52 -0400 Subject: [PATCH 07/49] Fix direct spec of iploc and fix numerous issues with controls --- optvl/optvl_class.py | 44 ++++++++++++++++------------ optvl/utils/check_surface_dict.py | 2 +- src/amake.f | 48 +++++++++++++++---------------- 3 files changed, 51 insertions(+), 43 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 913dfda..38c0075 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -665,11 +665,11 @@ def check_type(key, avl_vars, given_val): # set the gloabl design variable options ndesign = len(input_dict.get("gname", [])) - self.set_avl_fort_arr("CASE_I","NDESIGN", ncontrol) + self.set_avl_fort_arr("CASE_I","NDESIGN", ndesign) if ndesign > self.NGMAX: raise RuntimeError(f"Number of specified design variables exceeds {self.NGMAX}. Raise NGMAX!") - for k in range(ncontrol): + for k in range(ndesign): self.avl.CASE_C.GNAME[k] = input_dict["gname"][k] @@ -879,19 +879,23 @@ def check_type(key, avl_vars, given_val): # --- setup control variables for each section --- # Load control surfaces if "icontd" in surf_dict.keys(): - for j in range(num_secs): + for idx_sec in range(num_secs): # check to make sure this section has control vars - if surf_dict["num_controls"][j] == 0: + if surf_dict["num_controls"][idx_sec] == 0: continue - + for key, avl_vars in self.con_surf_to_fort_var[surf_name].items(): avl_vars_secs = self.con_surf_to_fort_var[surf_name][key] - avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][j]) + avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][idx_sec]) if key not in surf_dict: raise ValueError(f"Key {key} not found in surf dictionary, `{surf_name}` but is required") - else: - val = surf_dict[key][j] + else: + # This has to be incremented by 1 for Fortran indexing + if key == "icontd": + val = surf_dict[key][idx_sec] + 1 + else: + val = surf_dict[key][idx_sec] check_type(key, avl_vars, val) self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val, slicer=avl_vars[2]) @@ -901,19 +905,23 @@ def check_type(key, avl_vars, given_val): # --- setup design variables for each section --- # Load design variables if "idestd" in surf_dict.keys(): - for j in range(num_secs): + for idx_sec in range(num_secs): # check to make sure this section has control vars - if surf_dict["num_design_vars"][j] == 0: + if surf_dict["num_design_vars"][idx_sec] == 0: continue for key, avl_vars in self.des_var_to_fort_var[surf_name].items(): avl_vars_secs = self.des_var_to_fort_var[surf_name][key] - avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][j]) + avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][idx_sec]) if key not in surf_dict: raise ValueError(f"Key {key} not found in surf dictionary, `{surf_name}` but is required") - else: - val = surf_dict[key][j] + else: + # This has to be incremented by 1 for Fortran indexing + if key == "idestd": + val = surf_dict[key][idx_sec] + 1 + else: + val = surf_dict[key][idx_sec] check_type(key, avl_vars, val) self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val, slicer=avl_vars[2]) @@ -1065,7 +1073,7 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n # Only add +1 for Fortran indexing if we are not explictly telling the routine to use # nspans by passing in all zeros - if (iptloc != 0).all(): + if not (iptloc == 0).all(): iptloc += 1 # These seem to mangle the mesh up, just do a simple transpose to the correct ordering # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0],mesh.shape[1]), order="F") @@ -1278,13 +1286,13 @@ def post_check_input(self, inputDict: dict): # Check controls and design variables per section for j in range(surf_dict["num_sections"]): - if self.avl.SURF_GEOM_I.NSCON[i, j] != surf_dict["num_controls"][j]: + if self.avl.SURF_GEOM_I.NSCON[j, i] != surf_dict["num_controls"][j]: raise RuntimeError( - f"Mismatch: NSCON[i,j] = {self.avl.SURF_GEOM_I.NSCON[i, j]}, Dictionary: {surf_dict['num_controls'][j]}" + f"Mismatch: NSCON[i,j] = {self.avl.SURF_GEOM_I.NSCON[j, i]}, Dictionary: {surf_dict['num_controls'][j]}" ) - if self.avl.SURF_GEOM_I.NSDES[i, j] != surf_dict["num_design_vars"][j]: + if self.avl.SURF_GEOM_I.NSDES[j, i] != surf_dict["num_design_vars"][j]: raise RuntimeError( - f"Mismatch: NSDES[i,j] = {self.avl.SURF_GEOM_I.NSDES[i, j]}, Dictionary: {surf_dict['num_design_vars'][j]}" + f"Mismatch: NSDES[i,j] = {self.avl.SURF_GEOM_I.NSDES[j, i]}, Dictionary: {surf_dict['num_design_vars'][j]}" ) # Check the global control and design var count diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index eae087e..022824a 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -218,7 +218,7 @@ def pre_check_input_dict(input_dict: dict): # Check if the section indices are provided if "iptloc" in input_dict["surfaces"][surface].keys(): # If they are make sure we provide one for every section - if len(input_dict["surfaces"][surface]["iptloc"]) != input_dict["num_sections"]: + if len(input_dict["surfaces"][surface]["iptloc"]) != input_dict["surfaces"][surface]["num_sections"]: raise ValueError("iptloc vector length does not match num_sections") # Check if the user provided nspans instead elif "nspans" in input_dict["surfaces"][surface].keys(): diff --git a/src/amake.f b/src/amake.f index 7683b3e..704ba8c 100644 --- a/src/amake.f +++ b/src/amake.f @@ -950,17 +950,17 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) CHCOSL_G(N) = 0. CHCOSR_G(N) = 0. - DO ISDES = 1, NSDES(idx_surf,isurf) - IF(IDESTD(ISDES,idx_surf,isurf).EQ.N) THEN - CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_surf,isurf)*DTR - CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_surf,isurf)*DTR + DO ISDES = 1, NSDES(idx_sec,isurf) + IF(IDESTD(ISDES,idx_sec,isurf).EQ.N) THEN + CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_sec,isurf)*DTR + CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_sec,isurf)*DTR ENDIF ENDDO - DO ISDES = 1, NSDES(idx_surf+1,isurf) - IF(IDESTD(ISDES,idx_surf+1,isurf).EQ.N) THEN - CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_surf+1,isurf)*DTR - CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_surf+1,isurf)*DTR + DO ISDES = 1, NSDES(idx_sec+1,isurf) + IF(IDESTD(ISDES,idx_sec+1,isurf).EQ.N) THEN + CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_sec+1,isurf)*DTR + CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_sec+1,isurf)*DTR ENDIF ENDDO ENDDO @@ -1074,11 +1074,11 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) ELSE ! control variable # N is active here - GAINDA(N) = GAIND(ICL,idx_surf ,isurf)*(1.0-FC) - & + GAIND(ICR,idx_surf+1,isurf)* FC + GAINDA(N) = GAIND(ICL,idx_sec ,isurf)*(1.0-FC) + & + GAIND(ICR,idx_sec+1,isurf)* FC - XHD = CHORDL*XHINGED(ICL,idx_surf ,isurf)*(1.0-FC) - & + CHORDR*XHINGED(ICR,idx_surf+1,isurf)* FC + XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) + & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC IF(XHD.GE.0.0) THEN ! TE control surface, with hinge at XHD XLED(N) = XHD @@ -1089,20 +1089,20 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) XTED(N) = -XHD ENDIF - VHX = VHINGED(1,ICL,idx_surf,isurf)*XYZSCAL(1,isurf) - VHY = VHINGED(2,ICL,idx_surf,isurf)*XYZSCAL(2,isurf) - VHZ = VHINGED(3,ICL,idx_surf,isurf)*XYZSCAL(3,isurf) + VHX = VHINGED(1,ICL,idx_sec,isurf)*XYZSCAL(1,isurf) + VHY = VHINGED(2,ICL,idx_sec,isurf)*XYZSCAL(2,isurf) + VHZ = VHINGED(3,ICL,idx_sec,isurf)*XYZSCAL(3,isurf) VSQ = VHX**2 + VHY**2 + VHZ**2 IF(VSQ.EQ.0.0) THEN ! default: set hinge vector along hingeline - VHX = XYZLES(1,idx_surf+1,isurf) - & + ABS(CHORDR*XHINGED(ICR,idx_surf+1,isurf)) - & - XYZLES(1,idx_surf ,isurf) - & - ABS(CHORDL*XHINGED(ICL,idx_surf,isurf)) - VHY = XYZLES(2,idx_surf+1,isurf) - & - XYZLES(2,idx_surf ,isurf) - VHZ = XYZLES(3,idx_surf+1,isurf) - & - XYZLES(3,idx_surf ,isurf) + VHX = mesh(1,1,iptr) + & + ABS(CHORDR*XHINGED(ICR,idx_sec+1,isurf)) + & - mesh(1,1,iptl) + & - ABS(CHORDL*XHINGED(ICL,idx_sec,isurf)) + VHY = mesh(2,1,iptr) + & - mesh(2,1,iptl) + VHZ = mesh(3,1,iptr) + & - mesh(3,1,iptl) VHX = VHX*XYZSCAL(1,isurf) VHY = VHY*XYZSCAL(2,isurf) VHZ = VHZ*XYZSCAL(3,isurf) @@ -1114,7 +1114,7 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) VHINGE(2,idx_strip,N) = VHY/VMOD VHINGE(3,idx_strip,N) = VHZ/VMOD - VREFL(idx_strip,N) = REFLD(ICL,idx_surf, isurf) + VREFL(idx_strip,N) = REFLD(ICL,idx_sec, isurf) IF(XHD .GE. 0.0) THEN PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD From b44366099e8fa3f46245185130de3ec79012ccb9 Mon Sep 17 00:00:00 2001 From: Joshua Anibal Date: Tue, 28 Oct 2025 11:11:22 -0700 Subject: [PATCH 08/49] tweak f2py interface to pass size explicitly --- src/amake.f | 83 ++++++++++++++++++++++++++++----------------- src/f2py/libavl.pyf | 10 +++--- 2 files changed, 57 insertions(+), 36 deletions(-) diff --git a/src/amake.f b/src/amake.f index 704ba8c..ad7e8ab 100644 --- a/src/amake.f +++ b/src/amake.f @@ -641,7 +641,7 @@ SUBROUTINE MAKESURF(ISURF) END ! MAKESURF subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, - & iptloc) + & iptloc, nsecsurf) ! This routine is a modified standalone version of the "fudging" ! operation in makesurf. The main purpose is to deal with cases ! where the user provide a mesh and does not specify the indicies @@ -650,15 +650,26 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, ! to be run as a preprocessing step to compute iptloc and the fudged mesh ! as once we have iptloc makesurf_mesh will know how to handle the sections. INCLUDE 'AVL.INC' - integer nx, ny, isurf, niptloc + ! input/output + integer nx, ny, nsecsurf, isurf integer isec, ipt, ipt1, ipt2, idx_sec, idx_pt - integer iptloc(NSEC(isurf)) + integer iptloc(nsecsurf) real mesh(3,nx,ny) - real ylen(NSEC(isurf)), yzlen(NSEC(isurf)) + + ! working variables + integer niptloc + real ylen(nsecsurf), yzlen(nsecsurf) real yptloc, yptdel, yp1, yp2, dy, dz, y_mesh, dy_mesh + + ! check that iptloc is the correct size + if (nsecsurf /= NSEC(isurf)) then + write(*,'(A,I2,A,I2)') 'given size of iptloc:',nsecsurf, + & ' does not match NSEC(isurf):', NSEC(isurf) + endif + ! Check if the mesh can be adjusted - if (ny < NSEC(isurf)) then + if (ny < nsecsurf) then print *, "*** Not enought spanwise nodes to split the mesh" stop end if @@ -670,30 +681,32 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, ! We only need to do this is there isn't already a guess for iptloc if (iptloc(1) .eq. 0) then - ! compute mesh y length - y_mesh = mesh(2,1,ny) - mesh(2,1,1) - dy_mesh = y_mesh/(NSEC(isurf)-1) - - ! Chop up into equal y length pieces - ylen(1) = 0. - do idx_sec = 2,NSEC(isurf) - ylen(idx_sec) = ylen(idx_sec-1) + dy_mesh - end do + ! compute mesh y length + y_mesh = mesh(2,1,ny) - mesh(2,1,1) + dy_mesh = y_mesh/(NSEC(isurf)-1) + write(*,*) 'y_mesh', y_mesh + write(*,*) 'dy_mesh', dy_mesh + + ! Chop up into equal y length pieces + ylen(1) = 0. + do idx_sec = 2,NSEC(isurf) + ylen(idx_sec) = ylen(idx_sec-1) + dy_mesh + end do - ! Find node nearest each section - do idx_sec = 2, NSEC(isurf)-1 - yptloc = 1.0E9 - iptloc(idx_sec) = 1 - do idx_pt = 1, ny - yptdel = abs(mesh(2,1,1)+ ylen(idx_sec) - mesh(2,1,idx_pt)) - if(yptdel .LT. yptloc) then - yptloc = yptdel - iptloc(idx_sec) = idx_pt - endif - enddo - enddo - iptloc(1) = 1 - iptloc(NSEC(isurf)) = ny + ! Find node nearest each section + do idx_sec = 2, NSEC(isurf)-1 + yptloc = 1.0E9 + iptloc(idx_sec) = 1 + do idx_pt = 1, ny + yptdel = abs(mesh(2,1,1)+ ylen(idx_sec) - mesh(2,1,idx_pt)) + if(yptdel .LT. yptloc) then + yptloc = yptdel + iptloc(idx_sec) = idx_pt + endif + enddo + enddo + iptloc(1) = 1 + iptloc(NSEC(isurf)) = ny end if ! NOTE-SB: I don't think we need this @@ -777,15 +790,19 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, end subroutine adjust_mesh_spacing - subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) + subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) c-------------------------------------------------------------- c Sets up all stuff for surface ISURF, C using info from configuration input file C and the given mesh coordinate array. c-------------------------------------------------------------- INCLUDE 'AVL.INC' - integer nx, ny + ! input/output + integer nx, ny, nsecsurf real mesh(3,nx,ny) + integer iptloc(nsecsurf) + + ! working variables real m1, m2, m3, f1, f2, dc1, dc2, dc, a1, a2, a3, xptxind1 PARAMETER (KCMAX=50, & KSMAX=500) @@ -796,10 +813,14 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) & CHSINR_G(NGMAX),CHCOSR_G(NGMAX) REAL XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) INTEGER ISCONL(NDMAX), ISCONR(NDMAX) - integer iptloc(NSEC(isurf)) integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, & idx_y + if (nsecsurf /= NSEC(isurf)) then + write(*,'(A,I2,A,I2)') 'given size of iptloc:',nsecsurf, + & ' does not match NSEC(isurf):', NSEC(isurf) + endif + ! If the user doesn't input a index vector telling us at what ! spanwise index each section is located they will have to have ! provided nspans otherwise they will have to go back and provide diff --git a/src/f2py/libavl.pyf b/src/f2py/libavl.pyf index f373a79..1fb5a13 100644 --- a/src/f2py/libavl.pyf +++ b/src/f2py/libavl.pyf @@ -135,15 +135,15 @@ python module libavl ! in real*8, intent(inout) :: asys(jemax,jemax) end subroutine get_system_matrix - subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc) ! in :libavl:amake.f + subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! in :libavl:amake.f integer :: isurf, nx, ny - integer :: iptloc(*) + integer :: iptloc(nsecsurf) real*8 :: mesh(3,nx,ny) end subroutine makesurf_mesh - subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc) ! in :libavl:amake.f - integer :: isurf, nx, ny - integer, intent(inout) :: iptloc(*) + subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc, nsecsurf) ! in :libavl:amake.f + integer :: isurf, nx, ny, nsecsurf + integer, intent(inout) :: iptloc(nsecsurf) real*8 :: mesh(3,nx,ny) end subroutine adjust_mesh_spacing From 419d72e90c0fa34c2f30f2ea84c8e271e45e24ee Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 28 Oct 2025 15:44:25 -0400 Subject: [PATCH 09/49] Fix broken ainc interp and fix broken camber slope interp --- src/amake.f | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/src/amake.f b/src/amake.f index ad7e8ab..f6ddbab 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1049,17 +1049,17 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! Strip left side incidence CHSIN = CHSINL + f1*(CHSINR-CHSINL) - CHCOS = CHSINL + f1*(CHCOSR-CHCOSL) + CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) AINC1(idx_strip) = ATAN2(CHSIN,CHCOS) ! Strip right side incidence CHSIN = CHSINL + f2*(CHSINR-CHSINL) - CHCOS = CHSINL + f2*(CHCOSR-CHCOSL) + CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) AINC2(idx_strip) = ATAN2(CHSIN,CHCOS) ! Strip mid-point incidence CHSIN = CHSINL + fc*(CHSINR-CHSINL) - CHCOS = CHSINL + fc*(CHCOSR-CHCOSL) + CHCOS = CHCOSL + fc*(CHCOSR-CHCOSL) AINC(idx_strip) = ATAN2(CHSIN,CHCOS) ! Set dv gains for incidence angles @@ -1253,19 +1253,22 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! Camber slope at control point CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), - & NSL,RC(1,idx_vor)/CHORD(idx_strip),SLOPEL, DSDX) + & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPEL, DSDX) CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), - & NSR,RC(1,idx_vor)/CHORD(idx_strip),SLOPER, DSDX) - + & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPER, DSDX) SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL & + fc *(CHORDR/CHORD(idx_strip))*SLOPER ! Camber slope at vortex mid-point CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), - & NSL,RV(1,idx_vor)/CHORD(idx_strip),SLOPEL, DSDX) + & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPEL, DSDX) CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), - & NSR,RV(1,idx_vor)/CHORD(idx_strip),SLOPER, DSDX) + & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPER, DSDX) SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL @@ -1310,8 +1313,11 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! Store the panel mid point for the next panel in the strip ! This gets used a lot here - xptxind1 = ((mesh(1,idx_x,(idx_y+1))-mesh(1,idx_x,idx_y))/2.)/ - & CHORD(idx_strip) + xptxind1 = (mesh(1,idx_x+1,idx_y) + & - RLE1(1,idx_strip))/CHORD1(idx_strip) + + xptxind2 = (mesh(1,idx_x+1,(idx_y+1)) + & - RLE2(1,idx_strip))/CHORD2(idx_strip) ! Interpolate cross section on left side CALL AKIMA( XLASEC(1,idx_sec,isurf), ZLASEC(1,idx_sec,isurf), @@ -1321,10 +1327,10 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! Interpolate cross section on right side CALL AKIMA( XLASEC(1,idx_sec+1,isurf),ZLASEC(1,idx_sec+1,isurf), - & NSR, xptxind1, ZL_R, DSDX) + & NSR, xptxind2, ZL_R, DSDX) - CALL AKIMA( XUASEC(1,idx_sec+1,isurf), ZUASEC(1,idx_sec+1,isurf), - & NSR, xptxind1, ZU_R, DSDX) + CALL AKIMA( XUASEC(1,idx_sec+1,isurf),ZUASEC(1,idx_sec+1,isurf), + & NSR, xptxind2, ZU_R, DSDX) ! Compute the left aft node of panel @@ -1346,7 +1352,7 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! Compute the right aft node of panel ! X-point XYN2(1,idx_vor) = RLE2(1,idx_strip) + - & xptxind1*CHORD2(idx_strip) + & xptxind2*CHORD2(idx_strip) ! Y-point XYN2(2,idx_vor) = RLE2(2,idx_strip) From ca41ba46eff241dff573a094da3dca6a754e8574 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Wed, 29 Oct 2025 13:47:02 -0400 Subject: [PATCH 10/49] Fixed multiple surfaces not being handled correct with custom meshes. fixed scale and translate of custom meshes not working --- optvl/optvl_class.py | 17 +++++++++++------ src/amake.f | 14 ++++++++++---- 2 files changed, 21 insertions(+), 10 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 38c0075..ba2f74b 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1277,23 +1277,28 @@ def post_check_input(self, inputDict: dict): # check number of sections, controls, and dvs if len(inputDict["surfaces"]) > 0: surf_names = list(inputDict["surfaces"].keys()) + idx_surf = 0 for i in range(len(inputDict["surfaces"])): surf_dict = inputDict["surfaces"][surf_names[i]] - if self.avl.SURF_GEOM_I.NSEC[i] != surf_dict["num_sections"]: + if self.avl.SURF_GEOM_I.NSEC[idx_surf] != surf_dict["num_sections"]: raise RuntimeError( - f"Mismatch: NSEC[i] = {self.avl.SURF_GEOM_I.NSEC[i]}, Dictionary: {surf_dict['num_sections']}" + f"Mismatch: NSEC[i] = {self.avl.SURF_GEOM_I.NSEC[idx_surf]}, Dictionary: {surf_dict['num_sections']}" ) # Check controls and design variables per section for j in range(surf_dict["num_sections"]): - if self.avl.SURF_GEOM_I.NSCON[j, i] != surf_dict["num_controls"][j]: + if self.avl.SURF_GEOM_I.NSCON[j, idx_surf] != surf_dict["num_controls"][j]: raise RuntimeError( - f"Mismatch: NSCON[i,j] = {self.avl.SURF_GEOM_I.NSCON[j, i]}, Dictionary: {surf_dict['num_controls'][j]}" + f"Mismatch: NSCON[i,j] = {self.avl.SURF_GEOM_I.NSCON[j, idx_surf]}, Dictionary: {surf_dict['num_controls'][j]}" ) - if self.avl.SURF_GEOM_I.NSDES[j, i] != surf_dict["num_design_vars"][j]: + if self.avl.SURF_GEOM_I.NSDES[j, idx_surf] != surf_dict["num_design_vars"][j]: raise RuntimeError( - f"Mismatch: NSDES[i,j] = {self.avl.SURF_GEOM_I.NSDES[j, i]}, Dictionary: {surf_dict['num_design_vars'][j]}" + f"Mismatch: NSDES[i,j] = {self.avl.SURF_GEOM_I.NSDES[j, idx_surf]}, Dictionary: {surf_dict['num_design_vars'][j]}" ) + + idx_surf += 1 + if "yduplicate" in surf_dict: + idx_surf += 1 # Check the global control and design var count if "dname" in inputDict.keys(): diff --git a/src/amake.f b/src/amake.f index f6ddbab..b82ffca 100644 --- a/src/amake.f +++ b/src/amake.f @@ -901,6 +901,12 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ICNTSEC(II) = iptloc(ISEC) ENDDO + ! Apply the scaling and translations to the mesh as a whole + do idx_dim = 1,3 + mesh(idx_dim,:,:) = XYZSCAL(idx_dim,isurf)*mesh(idx_dim,:,:) + & + XYZTRAN(idx_dim,isurf) + end do + ! Setup the strips @@ -1025,14 +1031,14 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! CHORD(idx_strip) = sqrt(m1**2 + m3**2) ! Strip width (leading edge) - m2 = mesh(2,1,idx_strip+1)-mesh(2,1,idx_strip) - m3 = mesh(3,1,idx_strip+1)-mesh(3,1,idx_strip) + m2 = mesh(2,1,idx_y+1)-mesh(2,1,idx_y) + m3 = mesh(3,1,idx_y+1)-mesh(3,1,idx_y) WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) ! Strip LE and TE sweep slopes - tanle(idx_strip) = (mesh(1,1,idx_strip+1)-mesh(1,1,idx_strip)) + tanle(idx_strip) = (mesh(1,1,idx_y+1)-mesh(1,1,idx_y)) & /WSTRIP(idx_strip) - tante(idx_strip) = (mesh(1,nx,idx_strip+1)-mesh(1,nx,idx_strip)) + tante(idx_strip) = (mesh(1,nx,idx_y+1)-mesh(1,nx,idx_y)) & /WSTRIP(idx_strip) ! Compute chord projections and strip twists From dc03dec577ce0dcd87682b231c5f5124e32c2308 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Thu, 30 Oct 2025 16:09:58 -0400 Subject: [PATCH 11/49] fix tecplot file writing --- optvl/optvl_class.py | 3 +++ 1 file changed, 3 insertions(+) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index ba2f74b..6145d06 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -644,6 +644,9 @@ def check_type(key, avl_vars, given_val): val = optional_header_defaults[key] else: raise ValueError(f"Key {key} not found in input dictionary but is required") + elif key == "title": + # We need to apply this function to the title string so that the tecplot file writing works correctly + val = self._str_to_fort_str(input_dict[key],num_max_char=120) else: val = input_dict[key] From 3728fd3b892300a35a31bc77366b05bdc2a5971d Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Thu, 30 Oct 2025 17:27:14 -0400 Subject: [PATCH 12/49] start figuring out an update routine --- src/amake.f | 52 ++++++++++++++++++++++++++++++++++++----- src/avl.f | 10 ++++---- src/includes/AVL.INC.in | 2 +- 3 files changed, 52 insertions(+), 12 deletions(-) diff --git a/src/amake.f b/src/amake.f index b82ffca..a8d6e8d 100644 --- a/src/amake.f +++ b/src/amake.f @@ -798,7 +798,7 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) c-------------------------------------------------------------- INCLUDE 'AVL.INC' ! input/output - integer nx, ny, nsecsurf + integer isurf, nx, ny, nsecsurf real mesh(3,nx,ny) integer iptloc(nsecsurf) @@ -1402,10 +1402,50 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) end subroutine makesurf_mesh + subroutine update_surface_mesh_HACK(isurf,mesh,nx,ny,iptloc, + & nsecsurf,lcount) +c-------------------------------------------------------------- +c HACK: This routine is a temporary solution that combines +c the functionality of makesurf_mesh with update_surfaces. +c note that unlike update_surfaces it can only update one +c surface at a time and requires the mesh for that surface +c ber provided as input. There is also a flag that tells +c the routine whether to reset the counters or not. This +c routine is a hack until I can find a better way to store +c meshes in the Fortran layer without flattening them. +c-------------------------------------------------------------- + include 'AVL.INC' + integer isurf, nx, ny, nsecsurf + real mesh(3,nx,ny) + integer iptloc(nsecsurf) + logical lcount + + if (lcount) then + NSTRIP = 0 + NVOR = 0 + end if + + + call makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) + + CALL ENCALC + + LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it + LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them + LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it + LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists + LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists + + end subroutine update_surfaces_mesh + subroutine update_surfaces() c-------------------------------------------------------------- c Updates all surfaces, using the stored data. +c Resets the strips and vorticies so that AVL rebuilds them +c from the updated geometry. Recomputes panels normals and +c tells AVL to rebuild the AIC and other aero related data +c arrays on the next execution. c-------------------------------------------------------------- include 'AVL.INC' @@ -1436,11 +1476,11 @@ subroutine update_surfaces() CALL ENCALC - LAIC = .FALSE. - LSRD = .FALSE. - LVEL = .FALSE. - LSOL = .FALSE. - LSEN = .FALSE. + LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it + LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them + LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it + LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists + LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists end subroutine update_surfaces diff --git a/src/avl.f b/src/avl.f index 5f6e413..0d2b8ca 100644 --- a/src/avl.f +++ b/src/avl.f @@ -460,11 +460,11 @@ SUBROUTINE loadGEO(geom_file) C----- initialize state C CALL VARINI C - LAIC = .FALSE. - LSRD = .FALSE. - LVEL = .FALSE. - LSOL = .FALSE. - LSEN = .FALSE. + LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it + LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them + LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it + LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists + LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists END diff --git a/src/includes/AVL.INC.in b/src/includes/AVL.INC.in index 57a389f..72d2b29 100644 --- a/src/includes/AVL.INC.in +++ b/src/includes/AVL.INC.in @@ -498,7 +498,7 @@ c & GAING(ICONX, NSMAX, NFMax) ! desgin variable gain -C !!--- end added variables for python geometry minipulation --- +C !!--- end added variables for python geometry manipulation --- COMMON /STRP_I/ & NSURFS(NSMAX), ! index of surface which contains this strip From 10ac86b29d48af767fc2a193486a6f25551ac0c3 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Fri, 31 Oct 2025 17:09:47 -0400 Subject: [PATCH 13/49] hacked in a way to update surfaces without store or allocating anything in common block --- optvl/optvl_class.py | 47 ++++++++++++++++++++++++++++++ src/amake.f | 68 ++++++++++++++++++++++++-------------------- src/f2py/libavl.pyf | 7 +++++ 3 files changed, 91 insertions(+), 31 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 6145d06..3056e23 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1091,6 +1091,53 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing + # Temporary helper function + def reset_vort_count(self): + self.avl.CASE_I.NSTRIP = 0 + self.avl.CASE_I.NVOR = 0 + + # Ideally there would be an update_surfaces routine in Fotran to do this with meshes but for now we need to do this. + def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup:float): + + # nx = copy.deepcopy(mesh.shape[0]) + # ny = copy.deepcopy(mesh.shape[1]) + + # Only add +1 for Fortran indexing if we are not explictly telling the routine to use + # nspans by passing in all zeros + if not (iptloc == 0).all(): + iptloc += 1 + # These seem to mangle the mesh up, just do a simple transpose to the correct ordering + # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0],mesh.shape[1]), order="F") + # iptloc = iptloc.ravel(order="C").reshape(iptloc.shape[::-1], order="F") + mesh = mesh.transpose((2,0,1)) + + # if update_nvs: + # self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 + + # if update_nvc: + # self.avl.SURF_GEOM_I.NVC[idx_surf] = nx-1 + + if idx_surf != 0: + if self.avl.SURF_GEOM_L.LDUPL[idx_surf-1]: + print(f"Surface {idx_surf} is a duplicated surface!") + else: + self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing + else: + self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing + + if self.avl.SURF_GEOM_L.LDUPL[idx_surf]: + self.avl.sdupl(idx_surf + 1, ydup, "YDUP") + + # Temporary helper function + def reset_avl_solver(self): + self.avl.CASE_L.LAIC = False + self.avl.CASE_L.LSRD = False + self.avl.CASE_L.LVEL = False + self.avl.CASE_L.LSOL = False + self.avl.CASE_L.LSEN = False + + + def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): diff --git a/src/amake.f b/src/amake.f index a8d6e8d..e247aa8 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1402,41 +1402,47 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) end subroutine makesurf_mesh - subroutine update_surface_mesh_HACK(isurf,mesh,nx,ny,iptloc, - & nsecsurf,lcount) -c-------------------------------------------------------------- -c HACK: This routine is a temporary solution that combines -c the functionality of makesurf_mesh with update_surfaces. -c note that unlike update_surfaces it can only update one -c surface at a time and requires the mesh for that surface -c ber provided as input. There is also a flag that tells -c the routine whether to reset the counters or not. This -c routine is a hack until I can find a better way to store -c meshes in the Fortran layer without flattening them. -c-------------------------------------------------------------- - include 'AVL.INC' - integer isurf, nx, ny, nsecsurf - real mesh(3,nx,ny) - integer iptloc(nsecsurf) - logical lcount - - if (lcount) then - NSTRIP = 0 - NVOR = 0 - end if +! subroutine update_surface_mesh_HACK(isurf,mesh,nx,ny,iptloc, +! & nsecsurf,lcount, lcall) +! c-------------------------------------------------------------- +! c HACK: This routine is a temporary solution that combines +! c the functionality of makesurf_mesh with update_surfaces. +! c note that unlike update_surfaces it can only update one +! c surface at a time and requires the mesh for that surface +! c ber provided as input. There is also a flag that tells +! c the routine whether to reset the counters or not. This +! c routine is a hack until I can find a better way to store +! c meshes in the Fortran layer without flattening them. +! c-------------------------------------------------------------- +! include 'AVL.INC' +! integer isurf, nx, ny, nsecsurf +! real mesh(3,nx,ny) +! integer iptloc(nsecsurf) +! logical lcount, lcall + +! if (lcount) then +! NSTRIP = 0 +! NVOR = 0 +! end if - call makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) +! call makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) - CALL ENCALC - - LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it - LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them - LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it - LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists - LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists +! if(ldupl(isurf)) then +! call sdupl(isurf,ydupl(isurf),'ydup') +! endif - end subroutine update_surfaces_mesh +! if (lcall) then +! CALL ENCALC + +! LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it +! LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them +! LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it +! LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists +! LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists +! end if + +! end subroutine update_surfaces_mesh subroutine update_surfaces() diff --git a/src/f2py/libavl.pyf b/src/f2py/libavl.pyf index 1fb5a13..81fa70a 100644 --- a/src/f2py/libavl.pyf +++ b/src/f2py/libavl.pyf @@ -180,5 +180,12 @@ python module libavl ! in real*8 :: xb(nb), yb(nb) logical :: storecoords end subroutine set_body_coordinates + + !subroutine update_surface_mesh_HACK(isurf,mesh,nx,ny,iptloc,nsecsurf,lcount,lcall) ! in :libavl:amake.f + !integer :: isurf, nx, ny, nsecsurf + !logical :: lcount, lcall + !real*8 :: mesh(3,nx,ny) + !integer :: iptloc(nsecsurf) + !end subroutine update_surfaces_mesh end interface end python module libavl From 455fe8138983915f43c8e6e4a6d3f67be9919a41 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 3 Nov 2025 19:21:56 -0500 Subject: [PATCH 14/49] WIP rework --- optvl/optvl_class.py | 33 +- src/amake.f | 669 ++++++++++++++++++++++++++++++++++++++++ src/includes/AVL.INC.in | 8 + 3 files changed, 694 insertions(+), 16 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 3056e23..65270a6 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1091,17 +1091,16 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing - # Temporary helper function - def reset_vort_count(self): - self.avl.CASE_I.NSTRIP = 0 - self.avl.CASE_I.NVOR = 0 - # Ideally there would be an update_surfaces routine in Fotran to do this with meshes but for now we need to do this. def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup:float): - # nx = copy.deepcopy(mesh.shape[0]) # ny = copy.deepcopy(mesh.shape[1]) + # reset the counters before starting the first surface + if idx_surf == 0: + self.avl.CASE_I.NSTRIP = 0 + self.avl.CASE_I.NVOR = 0 + # Only add +1 for Fortran indexing if we are not explictly telling the routine to use # nspans by passing in all zeros if not (iptloc == 0).all(): @@ -1128,16 +1127,18 @@ def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup: if self.avl.SURF_GEOM_L.LDUPL[idx_surf]: self.avl.sdupl(idx_surf + 1, ydup, "YDUP") - # Temporary helper function - def reset_avl_solver(self): - self.avl.CASE_L.LAIC = False - self.avl.CASE_L.LSRD = False - self.avl.CASE_L.LVEL = False - self.avl.CASE_L.LSOL = False - self.avl.CASE_L.LSEN = False - - - + # Reset AVL solver upon finishing the last surface + if (idx_surf == (self.get_num_surfaces()-1)): + self.avl.CASE_L.LAIC = False + self.avl.CASE_L.LSRD = False + self.avl.CASE_L.LVEL = False + self.avl.CASE_L.LSOL = False + self.avl.CASE_L.LSEN = False + + def update_surfaces_mesh(self, meshes:list, iptloc:list): + if len(meshes) != self.get_num_surfaces(): + raise ValueError("Must provide a mesh for each surface ") + for idx_surf in def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): diff --git a/src/amake.f b/src/amake.f index e247aa8..f32fcaf 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1372,6 +1372,675 @@ subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ZUPN2(idx_vor) = RLE2(3,idx_strip) + ZU*CHORD2(idx_strip) + idx_vor = idx_vor + 1 + end do ! End vortex loop + idx_strip = idx_strip + 1 + end do ! End strip loop + + end do ! End section loop + + ! Compute the wetted area + sum = 0.0 + wtot = 0.0 + DO JJ = 1, NJ(isurf) + J = JFRST(isurf) + JJ-1 + ASTRP = WSTRIP(J)*CHORD(J) + SUM = SUM + ASTRP + WTOT = WTOT + WSTRIP(J) + ENDDO + SSURF(isurf) = SUM + + IF(WTOT .EQ. 0.0) THEN + CAVESURF(isurf) = 0.0 + ELSE + CAVESURF(isurf) = sum/wtot + ENDIF + ! add number of strips to the global count + NSTRIP = NSTRIP + NJ(isurf) + ! add number of of votrices to the global count + NVOR = NVOR + NK(isurf)*NJ(isurf) + + end subroutine makesurf_mesh + + integer function flatidx(idx_x, idx_y, idx_surf) + include 'AVL.INC' + ! store MFRST and NVC in the common block + integer idx_x, idx_y, idx_surf + flatidx = idx_x + (idx_y - 1) * NVC(idx_surf) + return + end function flatidx + + subroutine makesurf_mesh(isurf) +c-------------------------------------------------------------- +c Sets up all stuff for surface ISURF, +C using info from configuration input file +C and the given mesh coordinate array. +c-------------------------------------------------------------- + INCLUDE 'AVL.INC' + ! input/output + integer isurf + + ! working variables + real m1, m2, m3, f1, f2, dc1, dc2, dc, a1, a2, a3, xptxind1 + PARAMETER (KCMAX=50, + & KSMAX=500) + real CHSIN, CHCOS, CHSINL, CHSINR, CHCOSL, CHCOSR, AINCL, AINCR, + & CHORDL, CHORDR, CLAFL, CLAFR, SLOPEL, SLOPER, DXDX, ZU_L, + & ZL_L, ZU_R, ZL_R, ZL, ZR, SUM, WTOT, ASTRP + REAL CHSINL_G(NGMAX),CHCOSL_G(NGMAX), + & CHSINR_G(NGMAX),CHCOSR_G(NGMAX) + REAL XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) + INTEGER ISCONL(NDMAX), ISCONR(NDMAX) + real mesh_surf(3,(NVC(isurf)+1)*(NVS(isurf)+1)) + integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, + & idx_node, idx_nodel, idx_noder, idx_node_yp1, idx_node_nx, + & idx_y, nx, ny + + ! Get data from common block + nx = NVC(isurf) + 1 + ny = NVS(isurf) + 1 + + ! If the user doesn't input a index vector telling us at what + ! spanwise index each section is located they will have to have + ! provided nspans otherwise they will have to go back and provide + ! iptloc or run adjust_mesh_spacing as a preprocessing step to get + ! a iptloc vector. + if (IPTSEC(1,isurf) .eq. 0) then + ! if NSPANS is given then use it + if (NSPANS(1,isurf) .ne. 0) then + IPTSEC(1,isurf) = 1 + do idx_sec = 2,NSEC(isurf) + IPTSEC(idx_sec,isurf) = IPTSEC(idx_sec-1,isurf) + + & NSPANS(idx_sec-1,isurf) + end do + else + print *, '* Provide NSPANS or IPTLOC. (Hint: Run adjust_mesh_& + & spacing)' + stop + end if + end if + + ! Check MFRST + if (MFRST(isurf) .eq. 0) then + print *, "* Provide the index where the mesh begins for surface", + & isurf + end if + + ! Get the mesh from the the common block + mesh_surf = MSHBLK(:,MFRST(isurf):MFRST(isurf)+(nx*ny)-1) + + ! Perform input checks from makesurf + + IF(NSEC(ISURF).LT.2) THEN + WRITE(*,*) '*** Need at least 2 sections per surface.' + STOP + ENDIF + + IF(NVC(ISURF).GT.KCMAX) THEN + WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KCMAX to', + & NVC(ISURF) + NVC(ISURF) = KCMAX + ENDIF + + IF(NVS(ISURF).GT.KSMAX) THEN + WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KSMAX to', + & NVS(ISURF) + NVS(ISURF) = KSMAX + ENDIF + + ! Image flag set to indicate section definition direction + ! IMAGS= 1 defines edge 1 located at surface root edge + ! IMAGS=-1 defines edge 2 located at surface root edge (reflected surfaces) + IMAGS(ISURF) = 1 + + ! Start accumulating the element and strip index references + ! Accumulate the first element in surface + if (ISURF == 1) then + IFRST(ISURF) = 1 + else + IFRST(ISURF) = IFRST(ISURF-1) + NK(ISURF-1)*NJ(ISURF-1) + endif + + ! Accumulate the first strip in surface + if (ISURF == 1) then + JFRST(ISURF) = 1 + else + JFRST(ISURF) = JFRST(ISURF-1) + NJ(ISURF-1) + endif + + ! Set NK from input data (python layer will ensure this is consistent) + NK(ISURF) = NVC(ISURF) + + ! We need to start counting strips now since it's a global count + idx_strip = JFRST(ISURF) + + ! Bypass the entire spanwise node generation routine and go straight to store counters + ! Index of first section in surface + IF (ISURF .EQ. 1) THEN + ICNTFRST(ISURF) = 1 + ELSE + ICNTFRST(ISURF) = ICNTFRST(ISURF-1) + NCNTSEC(ISURF-1) + ENDIF + ! Number of sections in surface + NCNTSEC(ISURF) = NSEC(ISURF) + ! Store the spanwise index of each section in each surface + DO ISEC = 1, NSEC(ISURF) + II = ICNTFRST(ISURF) + (ISEC-1) + ICNTSEC(II) = IPTSEC(ISEC,isurf) + ENDDO + + + ! Apply the scaling and translations to the mesh as a whole + do idx_y = 1:ny + do idx_x = 1:nx + do idx_dim = 1,3 + idx_node = flatidx(idx_x, idx_y, idx_surf) + mesh_surf(idx_dim,idx_node) = XYZSCAL(idx_dim,isurf) + & *mesh_surf(idx_dim,idx_node) + XYZTRAN(idx_dim,isurf) + end do + end do + end do + + + ! Setup the strips + + ! Set spanwise elements to 0 + NJ(ISURF) = 0 + + ! Check control and design vars (input routine should've already checked this tbh) + IF(NCONTROL.GT.NDMAX) THEN + WRITE(*,*) '*** Too many control variables. Increase NDMAX to', + & NCONTROL + STOP + ENDIF + + IF(NDESIGN.GT.NGMAX) THEN + WRITE(*,*) '*** Too many design variables. Increase NGMAX to', + & NDESIGN + STOP + ENDIF + + + ! Loop over sections + do idx_sec = 1, NSEC(isurf)-1 + + ! Set reference information for the section + iptl = IPTSEC(idx_sec,isurf) + iptr = IPTSEC(idx_sec+1,isurf) + nspan = iptr - iptl + NJ(isurf) = NJ(isurf) + nspan + + + ! We need to compute the chord and claf values at the left and right edge of the section + ! These will be needed by AVL for control surface setup and control point placement + idx_node = flatidx(1,iptl,isurf) + idx_node_nx = flatidx(nx,iptl,isurf) + CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 + & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) + idx_node = flatidx(1,iptr,isurf) + idx_node_nx = flatidx(nx,iptr,isurf) + CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 + & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) + CLAFL = CLAF(idx_sec, isurf) + CLAFR = CLAF(idx_sec+1,isurf) + + ! Compute the incidence angle at the section end points + ! We will need this later to iterpolate chord projections + AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR + AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR + ! CHSINL = CHORDL*SIN(AINCL) + ! CHSINR = CHORDR*SIN(AINCR) + ! CHCOSL = CHORDL*COS(AINCL) + ! CHCOSR = CHORDR*COS(AINCR) + ! Note that I'm no longer scaling by chord here + ! but I'm keeping the variable names the same + ! Just to allow for an easy switch back to the old style for now + CHSINL = SIN(AINCL) + CHSINR = SIN(AINCR) + CHCOSL = COS(AINCL) + CHCOSR = COS(AINCR) + + ! We need to determine which controls belong to this section + ! Bring over the routine for this from makesurf + DO N = 1, NCONTROL + ISCONL(N) = 0 + ISCONR(N) = 0 + DO ISCON = 1, NSCON(idx_sec,isurf) + IF(ICONTD(ISCON,idx_sec,isurf) .EQ.N) ISCONL(N) = ISCON + ENDDO + DO ISCON = 1, NSCON(idx_sec+1,isurf) + IF(ICONTD(ISCON,idx_sec+1,isurf).EQ.N) ISCONR(N) = ISCON + ENDDO + ENDDO + + ! We need to determine which dvs belong to this section + ! and setup the chord projection gains + ! Bring over the routine for this from makesurf + DO N = 1, NDESIGN + CHSINL_G(N) = 0. + CHSINR_G(N) = 0. + CHCOSL_G(N) = 0. + CHCOSR_G(N) = 0. + + DO ISDES = 1, NSDES(idx_sec,isurf) + IF(IDESTD(ISDES,idx_sec,isurf).EQ.N) THEN + CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_sec,isurf)*DTR + CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_sec,isurf)*DTR + ENDIF + ENDDO + + DO ISDES = 1, NSDES(idx_sec+1,isurf) + IF(IDESTD(ISDES,idx_sec+1,isurf).EQ.N) THEN + CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_sec+1,isurf)*DTR + CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_sec+1,isurf)*DTR + ENDIF + ENDDO + ENDDO + + + ! Set the strip geometry data + ! Note these computations assume the mesh is not necessarily planar + ! but will still work correctly for a planar mesh as well + + ! Loop over strips in section + do ispan = 1,nspan + idx_y = idx_strip - JFRST(isurf) + 1 + + ! Strip left side + idx_node = flatidx(1,idx_y,isurf) + idx_node_nx = flatidx(nx,idx_y,isurf) + do idx_dim = 1,3 + RLE1(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node) + end do + CHORD1(idx_strip) = sqrt((mesh_surf(1,idx_node_nx) + & -mesh_surf(1,idx_node))**2 + (mesh_surf(3,idx_node_nx) + & -mesh_surf(3,idx_node))**2) + + ! Strip right side + idx_node = flatidx(1,idx_y+1,isurf) + idx_node_nx = flatidx(nx,idx_y+1,isurf) + do idx_dim = 1,3 + RLE2(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node) + end do + CHORD2(idx_strip) = = sqrt((mesh_surf(1,idx_node_nx) + & -mesh_surf(1,idx_node))**2 + (mesh_surf(3,idx_node_nx) + & -mesh_surf(3,idx_node))**2) + + ! Strip mid-point + do idx_dim = 1,3 + ! Since the strips are linear we can just interpolate + RLE(idx_dim,idx_strip) = (RLE1(idx_dim,idx_strip) + & + RLE2(idx_dim,idx_strip))/2. + ! RLE(idx_dim,idx_strip) = (mesh(idx_dim,1,idx_y+1)+mesh(idx_dim,1,idx_y))/2 + end do + ! Since the strips are linear we can just interpolate + CHORD(idx_strip) = (CHORD1(idx_strip)+CHORD2(idx_strip))/2. +! m1 = ((mesh(1,nx,idx_y+1)+mesh(1,nx,idx_y))/2) - +! & ((mesh(1,1,idx_y+1)+mesh(1,1,idx_y))/2) +! m3 = ((mesh(3,nx,idx_y+1)+mesh(3,nx,idx_y))/2) - +! & ((mesh(3,1,idx_y+1)+mesh(3,1,idx_y))/2) +! CHORD(idx_strip) = sqrt(m1**2 + m3**2) + + ! Strip width (leading edge) + idx_node = flatidx(1,idx_y,isurf) + idx_node_yp1 = flatidx(1,idx_y+1,isurf) + m2 = mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_node) + m3 = mesh_surf(3,idx_node_yp1)-mesh_surf(3,idx_node) + WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) + + ! Strip LE and TE sweep slopes + tanle(idx_strip) = (mesh_surf(1,idx_node_yp1) + & -mesh_surf(1,idx_node))/WSTRIP(idx_strip) + idx_node = flatidx(nx,idx_y,isurf) + idx_node_yp1 = flatidx(nx,idx_y+1,isurf) + tante(idx_strip) = (mesh_surf(1,idx_node_yp1) + & -mesh_surf(1,idx_node))/WSTRIP(idx_strip) + + ! Compute chord projections and strip twists + ! In AVL the AINCS are not interpolated. The chord projections are + ! So we have to replicate this effect. + + ! LINEAR interpolation over the section: left, right, and midpoint + idx_nodel = flatidx(1,iptl,isurf) + idx_noder = flatidx(1,iptr,isurf) + idx_node = flatidx(1,idx_y,isurf) + idx_node_yp1 = flatidx(1,idx_y+1,isurf) + + f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ + & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) + f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ + & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) + fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) + & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) + & -mesh_surf(2,idx_nodel)) + + ! Strip left side incidence + CHSIN = CHSINL + f1*(CHSINR-CHSINL) + CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) + AINC1(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Strip right side incidence + CHSIN = CHSINL + f2*(CHSINR-CHSINL) + CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) + AINC2(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Strip mid-point incidence + CHSIN = CHSINL + fc*(CHSINR-CHSINL) + CHCOS = CHCOSL + fc*(CHCOSR-CHCOSL) + AINC(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Set dv gains for incidence angles + ! Bring over the routine for this from make surf + DO N = 1, NDESIGN + CHSIN_G = ((1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) + CHCOS_G = (1.0-FC)*CHCOSL_G(N) + FC*CHCOSR_G(N) + AINC_G(idx_strip,N) = (CHCOS*CHSIN_G - CHSIN*CHCOS_G) + & / (CHSIN**2 + CHCOS**2) + ENDDO + + ! We have to now setup any control surfaces we defined for this section + ! Bring over the routine for this from Drela + DO N = 1, NCONTROL + ICL = ISCONL(N) + ICR = ISCONR(N) + + IF(ICL.EQ.0 .OR. ICR.EQ.0) THEN + ! no control effect here + GAINDA(N) = 0. + XLED(N) = 0. + XTED(N) = 0. + + VHINGE(1,idx_strip,N) = 0. + VHINGE(2,idx_strip,N) = 0. + VHINGE(3,idx_strip,N) = 0. + + VREFL(idx_strip,N) = 0. + + PHINGE(1,idx_strip,N) = 0. + PHINGE(2,idx_strip,N) = 0. + PHINGE(3,idx_strip,N) = 0. + + ELSE + ! control variable # N is active here + GAINDA(N) = GAIND(ICL,idx_sec ,isurf)*(1.0-FC) + & + GAIND(ICR,idx_sec+1,isurf)* FC + +! XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) +! & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC + ! iterpolate then scale by chord + XHD = (XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) + & + XHINGED(ICR,idx_sec+1,isurf)*FC)*CHORD(idx_strip) + IF(XHD.GE.0.0) THEN + ! TE control surface, with hinge at XHD + XLED(N) = XHD + XTED(N) = CHORD(idx_strip) + ELSE + ! LE control surface, with hinge at -XHD + XLED(N) = 0.0 + XTED(N) = -XHD + ENDIF + + VHX = VHINGED(1,ICL,idx_sec,isurf)*XYZSCAL(1,isurf) + VHY = VHINGED(2,ICL,idx_sec,isurf)*XYZSCAL(2,isurf) + VHZ = VHINGED(3,ICL,idx_sec,isurf)*XYZSCAL(3,isurf) + VSQ = VHX**2 + VHY**2 + VHZ**2 + IF(VSQ.EQ.0.0) THEN + ! default: set hinge vector along hingeline + idx_nodel = flatidx(1,iptl,isurf) + idx_noder = flatidx(1,iptr,isurf) + ! We are just setting the hinge line across the section + ! this assumes the hinge is linear even for a nonlinear + ! wing which I assume is a fair assumption + VHX = mesh_surf(1,idx_noder) + & + ABS(CHORDR*XHINGED(ICR,idx_sec+1,isurf)) + & - mesh_surf(1,idx_nodel) + & - ABS(CHORDL*XHINGED(ICL,idx_sec,isurf)) + VHY = mesh_surf(2,idx_noder) + & - mesh_surf(2,idx_nodel) + VHZ = mesh_surf(3,idx_noder) + & - mesh_surf(3,idx_nodel) + VHX = VHX*XYZSCAL(1,isurf) + VHY = VHY*XYZSCAL(2,isurf) + VHZ = VHZ*XYZSCAL(3,isurf) + VSQ = VHX**2 + VHY**2 + VHZ**2 + ENDIF + + VMOD = SQRT(VSQ) + VHINGE(1,idx_strip,N) = VHX/VMOD + VHINGE(2,idx_strip,N) = VHY/VMOD + VHINGE(3,idx_strip,N) = VHZ/VMOD + + VREFL(idx_strip,N) = REFLD(ICL,idx_sec, isurf) + + IF(XHD .GE. 0.0) THEN + PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD + PHINGE(2,idx_strip,N) = RLE(2,idx_strip) + PHINGE(3,idx_strip,N) = RLE(3,idx_strip) + ELSE + PHINGE(1,idx_strip,N) = RLE(1,idx_strip) - XHD + PHINGE(2,idx_strip,N) = RLE(2,idx_strip) + PHINGE(3,idx_strip,N) = RLE(3,idx_strip) + ENDIF + ENDIF + ENDDO + + ! Interpolate CD-CL polar defining data from input sections to strips + DO idx_coef = 1, 6 + CLCD(idx_coef,idx_strip) = (1.0-fc)* + & CLCDSEC(idx_coef,idx_sec,isurf) + + & fc*CLCDSEC(idx_coef,idx_sec+1,isurf) + END DO + ! If the min drag is zero flag the strip as no-viscous data + LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) + + + ! Set the panel (vortex) geometry data + + ! Accumulate the strip element indicies and start counting vorticies + if (idx_strip ==1) then + IJFRST(idx_strip) = 1 + else + IJFRST(idx_strip) = IJFRST(idx_strip - 1) + + & NVSTRP(idx_strip - 1) + endif + idx_vor = IJFRST(idx_strip) + NVSTRP(idx_strip) = NVC(isurf) + + ! Associate each strip with a surface + NSURFS(idx_strip) = isurf + + ! Prepare for cross section interpolation + NSL = NASEC(idx_sec , isurf) + NSR = NASEC(idx_sec+1, isurf) + + ! Interpolate claf over the section + ! CHORDC = CHORD(idx_strip) + clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL + & + FC *(CHORDR/CHORD(idx_strip))*CLAFR + + ! loop over vorticies for the strip + do idx_x = 1, nvc(isurf) + + ! Left bound vortex points + ! Y- point + RV1(2,idx_vor) = mesh(2,idx_x,idx_y) + ! Compute the panel's left side chord and angle + dc1 = sqrt((mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))**2 + & + (mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y))**2) + a1 = atan2((mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y)), + & (mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))) + ! Place vortex at panel quarter chord + RV1(1,idx_vor) = mesh(1,idx_x,idx_y) + (dc1/4.)*cos(a1) + RV1(3,idx_vor) = mesh(3,idx_x,idx_y) + (dc1/4.)*sin(a1) + + ! Right bound vortex points + ! Y- point + RV2(2,idx_vor) = mesh(2,idx_x,idx_y+1) + ! Compute the panel's right side chord and angle + dc2 = sqrt((mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))**2 + & + (mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1))**2) + a2 = atan2((mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1)), + & (mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))) + ! Place vortex at panel quarter chord + RV2(1,idx_vor) = mesh(1,idx_x,idx_y+1) + (dc2/4.)*cos(a2) + RV2(3,idx_vor) = mesh(3,idx_x,idx_y+1) + (dc2/4.)*sin(a2) + + ! Mid-point bound vortex points + ! Y- point + RV(2,idx_vor) = (mesh(2,idx_x,idx_y+1) + mesh(2,idx_x,idx_y))/2. + ! Compute the panel's mid-point chord and angle + ! Panels themselves can never be curved so just interpolate the chord + ! store as the panel chord in common block + DXV(idx_vor) = (dc1+dc2)/2. + ! However compute the mid-point angle straight up since Drela never interpolates angles + a3 = atan2(((mesh(3,idx_x+1,idx_y+1) + mesh(3,idx_x+1,idx_y))/2. + & - (mesh(3,idx_x,idx_y+1) + mesh(3,idx_x,idx_y))/2.), + & ((mesh(1,idx_x+1,idx_y+1) + mesh(1,idx_x+1,idx_y))/2. + & - (mesh(1,idx_x,idx_y+1) + mesh(1,idx_x,idx_y))/2.)) + ! Place vortex at panel quarter chord + RV(1,idx_vor) = (mesh(1,idx_x,idx_y+1)+mesh(1,idx_x,idx_y))/2. + & + (DXV(idx_x)/4.)*cos(a3) + RV(3,idx_vor) = (mesh(3,idx_x,idx_y+1)+mesh(3,idx_x,idx_y))/2. + & + (DXV(idx_x)/4.)*sin(a3) + + + ! Panel Control points + ! Y- point + ! is just the panel midpoint + RC(2,idx_vor) = RV(2,idx_vor) + ! Place the control point at the quarter chord + half chord*clafc + ! note that clafc is a scaler so is 1. for 2pi + ! use data from vortex mid-point computation + RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) + RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) + + ! Source points + ! Y- point + RS(2,idx_vor) = RV(2,idx_vor) + ! Place the source point at the half chord + ! use data from vortex mid-point computation + ! add another quarter chord to the quarter chord + RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) + RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) + + + ! Set the camber slopes for the panel + + ! Camber slope at control point + CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), + & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPEL, DSDX) + CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), + & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPER, DSDX) + + SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + + ! Camber slope at vortex mid-point + CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), + & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPEL, DSDX) + CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), + & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPER, DSDX) + + + SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + + + ! Associate the panel with it's strip's chord and component + CHORDV(idx_vor) = CHORD(idx_strip) + NSURFV(idx_vor) = LSCOMP(isurf) + + ! Enforce no penetration at the control point + LVNC(idx_vor) = .true. + + ! element inherits alpha,beta flag from surface + LVALBE(idx_vor) = LFALBE(isurf) + + ! We need to scale the control surface gains by the fraction + ! of the element on the control surface + do N = 1, NCONTROL + !scale control gain by factor 0..1, (fraction of element on control surface) + FRACLE = (XLED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) + & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / + & (DXV(idx_vor)/CHORD(idx_strip)) + + FRACTE = (XTED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) + & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / + & (DXV(idx_vor)/CHORD(idx_strip)) + + FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) + FRACTE = MIN( 1.0 , MAX( 0.0 , FRACTE ) ) + + DCONTROL(idx_vor,N) = GAINDA(N)*(FRACTE-FRACLE) + end do + + ! TE control point used only if surface sheds a wake + LVNC(idx_vor) = LFWAKE(isurf) + + ! Use the cross sections to generate the OML + ! nodal grid associated with vortex strip (aft-panel nodes) + ! NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; + ! retained in (x,z) plane at this point + + ! Store the panel mid point for the next panel in the strip + ! This gets used a lot here + xptxind1 = (mesh(1,idx_x+1,idx_y) + & - RLE1(1,idx_strip))/CHORD1(idx_strip) + + xptxind2 = (mesh(1,idx_x+1,(idx_y+1)) + & - RLE2(1,idx_strip))/CHORD2(idx_strip) + + ! Interpolate cross section on left side + CALL AKIMA( XLASEC(1,idx_sec,isurf), ZLASEC(1,idx_sec,isurf), + & NSL,xptxind1, ZL_L, DSDX ) + CALL AKIMA( XUASEC(1,idx_sec,isurf), ZUASEC(1,idx_sec,isurf), + & NSL,xptxind1, ZU_L, DSDX ) + + ! Interpolate cross section on right side + CALL AKIMA( XLASEC(1,idx_sec+1,isurf),ZLASEC(1,idx_sec+1,isurf), + & NSR, xptxind2, ZL_R, DSDX) + + CALL AKIMA( XUASEC(1,idx_sec+1,isurf),ZUASEC(1,idx_sec+1,isurf), + & NSR, xptxind2, ZU_R, DSDX) + + + ! Compute the left aft node of panel + ! X-point + XYN1(1,idx_vor) = RLE1(1,idx_strip) + + & xptxind1*CHORD1(idx_strip) + + ! Y-point + XYN1(2,idx_vor) = RLE1(2,idx_strip) + + ! Interpolate z from sections to left aft node of panel + ZL = (1.-f1)*ZL_L + f1 *ZL_R + ZU = (1.-f1)*ZU_L + f1 *ZU_R + + ! Store left aft z-point + ZLON1(idx_vor) = RLE1(3,idx_strip) + ZL*CHORD1(idx_strip) + ZUPN1(idx_vor) = RLE1(3,idx_strip) + ZU*CHORD1(idx_strip) + + ! Compute the right aft node of panel + ! X-point + XYN2(1,idx_vor) = RLE2(1,idx_strip) + + & xptxind2*CHORD2(idx_strip) + + ! Y-point + XYN2(2,idx_vor) = RLE2(2,idx_strip) + + ! Interpolate z from sections to right aft node of panel + ZL = (1.-f2)*ZL_L + f2 *ZL_R + ZU = (1.-f2)*ZU_L + f2 *ZU_R + + ! Store right aft z-point + ZLON2(idx_vor) = RLE2(3,idx_strip) + ZL*CHORD2(idx_strip) + ZUPN2(idx_vor) = RLE2(3,idx_strip) + ZU*CHORD2(idx_strip) + + idx_vor = idx_vor + 1 end do ! End vortex loop idx_strip = idx_strip + 1 diff --git a/src/includes/AVL.INC.in b/src/includes/AVL.INC.in index 72d2b29..c4826a7 100644 --- a/src/includes/AVL.INC.in +++ b/src/includes/AVL.INC.in @@ -497,6 +497,14 @@ c & REFLD(ICONX, NSMAX, NFMAX), ! control surface reflection & GAING(ICONX, NSMAX, NFMax) ! desgin variable gain + COMMON /SURF_MESH_I/ + & MFRST(NFMAX), ! stores the index in the MSHBLK where each surface's mesh begins + & IPTSEC(NSMAX,NFMAX), ! stores the iptloc vector for each surface + + REAL(kind=avl_real) MSHBLK + COMMON /SURF_MESH_R/ + & MSHBLK(3, 4*NVMAX) ! block to store all surface meshes + C !!--- end added variables for python geometry manipulation --- From 27d8289a179f6c4f27af7ee90cc778124059dc2f Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 4 Nov 2025 17:15:29 -0500 Subject: [PATCH 15/49] Wip stuff --- src/amake.f | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/amake.f b/src/amake.f index f32fcaf..f823932 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1855,6 +1855,21 @@ subroutine makesurf_mesh(isurf) ! Interpolate claf over the section ! CHORDC = CHORD(idx_strip) + ! SAB: Two ways to handle this for non linear sections + ! 1. Interpolate claf as non dimensional quantity + ! 2. Piecewise linearly iterpolate + ! Option 1: + clafc = (1.-FC)*CLAFL + FC*CLAFR + ! Option 2: + fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) + & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) + & -mesh_surf(2,idx_nodel)) + ! accumulate piecewise linear interp + if (idx_strip .eq. JFRST(isurf)) then + + else + + end if clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL & + FC *(CHORDR/CHORD(idx_strip))*CLAFR @@ -1863,6 +1878,7 @@ subroutine makesurf_mesh(isurf) ! Left bound vortex points ! Y- point + idx_node = flatidx(idx_x,idx_y,isurf) RV1(2,idx_vor) = mesh(2,idx_x,idx_y) ! Compute the panel's left side chord and angle dc1 = sqrt((mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))**2 From 0514f65cee5fcff49dbec8aaa58a00a85030f53e Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Wed, 5 Nov 2025 18:23:59 -0500 Subject: [PATCH 16/49] Wip --- optvl/optvl_class.py | 8 +++--- src/amake.f | 60 +++++++++++++++++++++----------------------- 2 files changed, 33 insertions(+), 35 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 65270a6..1f46b76 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1135,10 +1135,10 @@ def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup: self.avl.CASE_L.LSOL = False self.avl.CASE_L.LSEN = False - def update_surfaces_mesh(self, meshes:list, iptloc:list): - if len(meshes) != self.get_num_surfaces(): - raise ValueError("Must provide a mesh for each surface ") - for idx_surf in + # def update_surfaces_mesh(self, meshes:list, iptloc:list): + # if len(meshes) != self.get_num_surfaces(): + # raise ValueError("Must provide a mesh for each surface ") + # for idx_surf in def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): diff --git a/src/amake.f b/src/amake.f index f823932..42d708a 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1586,19 +1586,24 @@ subroutine makesurf_mesh(isurf) ! Compute the incidence angle at the section end points ! We will need this later to iterpolate chord projections + ! SAB Note: This type of interpolation assumes the section + ! is linear. However, the twist angles it produces can be applied + ! to an arbitrary mesh. The user just needs to be aware of what they are + ! applying here. + ! Analogy: imagine that we create a trapazoidal section + ! that matches up with the root and tip chords of your arbitrary wing section + ! The trapzoid can encompass the wing section or parts of the section can be + ! protruding out side the trapazoid. It doesn't matter. Now we twist the trapazoid + ! so that the angles at the root and tip match what is specified at the sections in + ! AINCS. However, when we twist we make sure to keep the leading and trailing edges + ! linear (straight line along the LE and TE). The angles at each strip required to + ! do are what gets applied to the normal vector at each strip. AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR - ! CHSINL = CHORDL*SIN(AINCL) - ! CHSINR = CHORDR*SIN(AINCR) - ! CHCOSL = CHORDL*COS(AINCL) - ! CHCOSR = CHORDR*COS(AINCR) - ! Note that I'm no longer scaling by chord here - ! but I'm keeping the variable names the same - ! Just to allow for an easy switch back to the old style for now - CHSINL = SIN(AINCL) - CHSINR = SIN(AINCR) - CHCOSL = COS(AINCL) - CHCOSR = COS(AINCR) + CHSINL = CHORDL*SIN(AINCL) + CHSINR = CHORDR*SIN(AINCR) + CHCOSL = CHORDL*COS(AINCL) + CHCOSR = CHORDR*COS(AINCR) ! We need to determine which controls belong to this section ! Bring over the routine for this from makesurf @@ -1765,11 +1770,12 @@ subroutine makesurf_mesh(isurf) GAINDA(N) = GAIND(ICL,idx_sec ,isurf)*(1.0-FC) & + GAIND(ICR,idx_sec+1,isurf)* FC -! XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) -! & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC - ! iterpolate then scale by chord - XHD = (XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) - & + XHINGED(ICR,idx_sec+1,isurf)*FC)*CHORD(idx_strip) + ! SAB Note: This iterpolation ensures that the hinge line is + ! is linear which I think it is an ok assumption for arbitrary wings + ! as long as the user is aware + ! A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord + XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) + & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC IF(XHD.GE.0.0) THEN ! TE control surface, with hinge at XHD XLED(N) = XHD @@ -1855,23 +1861,15 @@ subroutine makesurf_mesh(isurf) ! Interpolate claf over the section ! CHORDC = CHORD(idx_strip) - ! SAB: Two ways to handle this for non linear sections - ! 1. Interpolate claf as non dimensional quantity - ! 2. Piecewise linearly iterpolate + ! SAB: In AVL this quantity is interpolated as a product with chord + ! We then divide by the chord at the strip to recover claf at the strip + ! This only works correctly for linear sections so we have to make a change + ! here to account for nonlinear(really piecewise linear) sections + ! The chord multiplication here ! Option 1: clafc = (1.-FC)*CLAFL + FC*CLAFR - ! Option 2: - fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) - & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) - & -mesh_surf(2,idx_nodel)) - ! accumulate piecewise linear interp - if (idx_strip .eq. JFRST(isurf)) then - - else - - end if - clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL - & + FC *(CHORDR/CHORD(idx_strip))*CLAFR +! clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL +! & + FC *(CHORDR/CHORD(idx_strip))*CLAFR ! loop over vorticies for the strip do idx_x = 1, nvc(isurf) From 488a312d0149c85cf16c61d4822f95faa0c039d3 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 17 Nov 2025 18:22:16 -0500 Subject: [PATCH 17/49] Finally finished the flat index rework for direct mesh --- src/amake.f | 766 +++++----------------------------------- src/includes/AVL.INC.in | 2 +- 2 files changed, 84 insertions(+), 684 deletions(-) diff --git a/src/amake.f b/src/amake.f index 42d708a..c9fcd03 100644 --- a/src/amake.f +++ b/src/amake.f @@ -790,622 +790,11 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, end subroutine adjust_mesh_spacing - subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) -c-------------------------------------------------------------- -c Sets up all stuff for surface ISURF, -C using info from configuration input file -C and the given mesh coordinate array. -c-------------------------------------------------------------- - INCLUDE 'AVL.INC' - ! input/output - integer isurf, nx, ny, nsecsurf - real mesh(3,nx,ny) - integer iptloc(nsecsurf) - - ! working variables - real m1, m2, m3, f1, f2, dc1, dc2, dc, a1, a2, a3, xptxind1 - PARAMETER (KCMAX=50, - & KSMAX=500) - real CHSIN, CHCOS, CHSINL, CHSINR, CHCOSL, CHCOSR, AINCL, AINCR, - & CHORDL, CHORDR, CLAFL, CLAFR, SLOPEL, SLOPER, DXDX, ZU_L, - & ZL_L, ZU_R, ZL_R, ZL, ZR, SUM, WTOT, ASTRP - REAL CHSINL_G(NGMAX),CHCOSL_G(NGMAX), - & CHSINR_G(NGMAX),CHCOSR_G(NGMAX) - REAL XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) - INTEGER ISCONL(NDMAX), ISCONR(NDMAX) - integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, - & idx_y - - if (nsecsurf /= NSEC(isurf)) then - write(*,'(A,I2,A,I2)') 'given size of iptloc:',nsecsurf, - & ' does not match NSEC(isurf):', NSEC(isurf) - endif - - ! If the user doesn't input a index vector telling us at what - ! spanwise index each section is located they will have to have - ! provided nspans otherwise they will have to go back and provide - ! iptloc or run adjust_mesh_spacing as a preprocessing step to get - ! a iptloc vector. - if (iptloc(1) .eq. 0) then - ! if NSPANS is given then use it - if (NSPANS(1,isurf) .ne. 0) then - iptloc(1) = 1 - do idx_sec = 2,NSEC(isurf) - iptloc(idx_sec) = iptloc(idx_sec-1) + NSPANS(idx_sec-1,isurf) - end do - else - print *, '* Provide NSPANS or IPTLOC. (Hint: Run adjust_mesh_& - & spacing)' - stop - end if - end if - - - ! Perform input checks from makesurf - - IF(NSEC(ISURF).LT.2) THEN - WRITE(*,*) '*** Need at least 2 sections per surface.' - STOP - ENDIF - - IF(NVC(ISURF).GT.KCMAX) THEN - WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KCMAX to', - & NVC(ISURF) - NVC(ISURF) = KCMAX - ENDIF - - IF(NVS(ISURF).GT.KSMAX) THEN - WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KSMAX to', - & NVS(ISURF) - NVS(ISURF) = KSMAX - ENDIF - - ! Image flag set to indicate section definition direction - ! IMAGS= 1 defines edge 1 located at surface root edge - ! IMAGS=-1 defines edge 2 located at surface root edge (reflected surfaces) - IMAGS(ISURF) = 1 - - ! Start accumulating the element and strip index references - ! Accumulate the first element in surface - if (ISURF == 1) then - IFRST(ISURF) = 1 - else - IFRST(ISURF) = IFRST(ISURF-1) + NK(ISURF-1)*NJ(ISURF-1) - endif - - ! Accumulate the first strip in surface - if (ISURF == 1) then - JFRST(ISURF) = 1 - else - JFRST(ISURF) = JFRST(ISURF-1) + NJ(ISURF-1) - endif - - ! Set NK from input data (python layer will ensure this is consistent) - NK(ISURF) = NVC(ISURF) - - ! We need to start counting strips now since it's a global count - idx_strip = JFRST(ISURF) - - ! Bypass the entire spanwise node generation routine and go straight to store counters - ! Index of first section in surface - IF (ISURF .EQ. 1) THEN - ICNTFRST(ISURF) = 1 - ELSE - ICNTFRST(ISURF) = ICNTFRST(ISURF-1) + NCNTSEC(ISURF-1) - ENDIF - ! Number of sections in surface - NCNTSEC(ISURF) = NSEC(ISURF) - ! Store the spanwise index of each section in each surface - DO ISEC = 1, NSEC(ISURF) - II = ICNTFRST(ISURF) + (ISEC-1) - ICNTSEC(II) = iptloc(ISEC) - ENDDO - - ! Apply the scaling and translations to the mesh as a whole - do idx_dim = 1,3 - mesh(idx_dim,:,:) = XYZSCAL(idx_dim,isurf)*mesh(idx_dim,:,:) - & + XYZTRAN(idx_dim,isurf) - end do - - - ! Setup the strips - - ! Set spanwise elements to 0 - NJ(ISURF) = 0 - - ! Check control and design vars (input routine should've already checked this tbh) - IF(NCONTROL.GT.NDMAX) THEN - WRITE(*,*) '*** Too many control variables. Increase NDMAX to', - & NCONTROL - STOP - ENDIF - - IF(NDESIGN.GT.NGMAX) THEN - WRITE(*,*) '*** Too many design variables. Increase NGMAX to', - & NDESIGN - STOP - ENDIF - - - ! Loop over sections - do idx_sec = 1, NSEC(isurf)-1 - - ! Set reference information for the section - iptl = iptloc(idx_sec) - iptr = iptloc(idx_sec+1) - nspan = iptr - iptl - NJ(isurf) = NJ(isurf) + nspan - - - ! We need to compute the chord and claf values at the left and right edge of the section - ! These will be needed by AVL for control surface setup and control point placement - CHORDL = sqrt((mesh(1,nx,iptl)-mesh(1,1,iptl))**2 + - & (mesh(3,nx,iptl)-mesh(3,1,iptl))**2) - CHORDR = sqrt((mesh(1,nx,iptr)-mesh(1,1,iptr))**2 + - & (mesh(3,nx,iptr)-mesh(3,1,iptr))**2) - CLAFL = CLAF(idx_sec, isurf) - CLAFR = CLAF(idx_sec+1,isurf) - - ! Compute the incidence angle at the section end points - ! We will need this later to iterpolate chord projections - AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR - AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR - CHSINL = CHORDL*SIN(AINCL) - CHSINR = CHORDR*SIN(AINCR) - CHCOSL = CHORDL*COS(AINCL) - CHCOSR = CHORDR*COS(AINCR) - - ! We need to determine which controls belong to this section - ! Bring over the routine for this from Drela - DO N = 1, NCONTROL - ISCONL(N) = 0 - ISCONR(N) = 0 - DO ISCON = 1, NSCON(idx_sec,isurf) - IF(ICONTD(ISCON,idx_sec,isurf) .EQ.N) ISCONL(N) = ISCON - ENDDO - DO ISCON = 1, NSCON(idx_sec+1,isurf) - IF(ICONTD(ISCON,idx_sec+1,isurf).EQ.N) ISCONR(N) = ISCON - ENDDO - ENDDO - - ! We need to determine which dvs belong to this section - ! and setup the chord projection gains - ! Bring over the routine for this from Drela - DO N = 1, NDESIGN - CHSINL_G(N) = 0. - CHSINR_G(N) = 0. - CHCOSL_G(N) = 0. - CHCOSR_G(N) = 0. - - DO ISDES = 1, NSDES(idx_sec,isurf) - IF(IDESTD(ISDES,idx_sec,isurf).EQ.N) THEN - CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_sec,isurf)*DTR - CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_sec,isurf)*DTR - ENDIF - ENDDO - - DO ISDES = 1, NSDES(idx_sec+1,isurf) - IF(IDESTD(ISDES,idx_sec+1,isurf).EQ.N) THEN - CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_sec+1,isurf)*DTR - CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_sec+1,isurf)*DTR - ENDIF - ENDDO - ENDDO - - - ! Set the strip geometry data - ! Note these computations assume the mesh is not necessarily planar - ! but will still work correctly for a planar mesh as well - - ! Loop over strips in section - do ispan = 1,nspan - idx_y = idx_strip - JFRST(isurf) + 1 - - ! Strip left side - do idx_dim = 1,3 - RLE1(idx_dim,idx_strip) = mesh(idx_dim,1,idx_y) - end do - CHORD1(idx_strip) = sqrt((mesh(1,nx,idx_y)-mesh(1,1,idx_y))**2 + - &(mesh(3,nx,idx_y)-mesh(3,1,idx_y))**2) - - ! Strip right side - do idx_dim = 1,3 - RLE2(idx_dim,idx_strip) = mesh(idx_dim,1,idx_y+1) - end do - CHORD2(idx_strip) = sqrt((mesh(1,nx,idx_y+1)-mesh(1,1,idx_y+1))**2 - & + (mesh(3,nx,idx_y+1)-mesh(3,1,idx_y+1))**2) - - ! Strip mid-point - do idx_dim = 1,3 - ! Since the strips are linear we can just interpolate - RLE(idx_dim,idx_strip) = (RLE1(idx_dim,idx_strip) - & + RLE2(idx_dim,idx_strip))/2. - ! RLE(idx_dim,idx_strip) = (mesh(idx_dim,1,idx_y+1)+mesh(idx_dim,1,idx_y))/2 - end do - ! Since the strips are linear we can just interpolate - CHORD(idx_strip) = (CHORD1(idx_strip)+CHORD2(idx_strip))/2. -! m1 = ((mesh(1,nx,idx_y+1)+mesh(1,nx,idx_y))/2) - -! & ((mesh(1,1,idx_y+1)+mesh(1,1,idx_y))/2) -! m3 = ((mesh(3,nx,idx_y+1)+mesh(3,nx,idx_y))/2) - -! & ((mesh(3,1,idx_y+1)+mesh(3,1,idx_y))/2) -! CHORD(idx_strip) = sqrt(m1**2 + m3**2) - - ! Strip width (leading edge) - m2 = mesh(2,1,idx_y+1)-mesh(2,1,idx_y) - m3 = mesh(3,1,idx_y+1)-mesh(3,1,idx_y) - WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) - - ! Strip LE and TE sweep slopes - tanle(idx_strip) = (mesh(1,1,idx_y+1)-mesh(1,1,idx_y)) - & /WSTRIP(idx_strip) - tante(idx_strip) = (mesh(1,nx,idx_y+1)-mesh(1,nx,idx_y)) - & /WSTRIP(idx_strip) - - ! Compute chord projections and strip twists - ! In AVL the AINCS are not interpolated. The chord projections are - ! So we have to replicate this effect. - - ! Interpolation over the section: left, right, and midpoint - f1 = (mesh(2,1,idx_y)-mesh(2,1,iptl))/ - & (mesh(2,1,iptr)-mesh(2,1,iptl)) - f2 = (mesh(2,1,idx_y+1)-mesh(2,1,iptl))/ - & (mesh(2,1,iptr)-mesh(2,1,iptl)) - fc = (((mesh(2,1,idx_y+1)+mesh(2,1,idx_y))/2.) - & -mesh(2,1,iptl))/(mesh(2,1,iptr)-mesh(2,1,iptl)) - - ! Strip left side incidence - CHSIN = CHSINL + f1*(CHSINR-CHSINL) - CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) - AINC1(idx_strip) = ATAN2(CHSIN,CHCOS) - - ! Strip right side incidence - CHSIN = CHSINL + f2*(CHSINR-CHSINL) - CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) - AINC2(idx_strip) = ATAN2(CHSIN,CHCOS) - - ! Strip mid-point incidence - CHSIN = CHSINL + fc*(CHSINR-CHSINL) - CHCOS = CHCOSL + fc*(CHCOSR-CHCOSL) - AINC(idx_strip) = ATAN2(CHSIN,CHCOS) - - ! Set dv gains for incidence angles - ! Bring over the routine for this from Drela - DO N = 1, NDESIGN - CHSIN_G = (1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) - CHCOS_G = (1.0-FC)*CHCOSL_G(N) + FC*CHCOSR_G(N) - AINC_G(idx_strip,N) = (CHCOS*CHSIN_G - CHSIN*CHCOS_G) - & / (CHSIN**2 + CHCOS**2) - ENDDO - - ! We have to now setup any control surfaces we defined for this section - ! Bring over the routine for this from Drela - DO N = 1, NCONTROL - ICL = ISCONL(N) - ICR = ISCONR(N) - - IF(ICL.EQ.0 .OR. ICR.EQ.0) THEN - ! no control effect here - GAINDA(N) = 0. - XLED(N) = 0. - XTED(N) = 0. - - VHINGE(1,idx_strip,N) = 0. - VHINGE(2,idx_strip,N) = 0. - VHINGE(3,idx_strip,N) = 0. - - VREFL(idx_strip,N) = 0. - - PHINGE(1,idx_strip,N) = 0. - PHINGE(2,idx_strip,N) = 0. - PHINGE(3,idx_strip,N) = 0. - - ELSE - ! control variable # N is active here - GAINDA(N) = GAIND(ICL,idx_sec ,isurf)*(1.0-FC) - & + GAIND(ICR,idx_sec+1,isurf)* FC - - XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) - & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC - IF(XHD.GE.0.0) THEN - ! TE control surface, with hinge at XHD - XLED(N) = XHD - XTED(N) = CHORD(idx_strip) - ELSE - ! LE control surface, with hinge at -XHD - XLED(N) = 0.0 - XTED(N) = -XHD - ENDIF - - VHX = VHINGED(1,ICL,idx_sec,isurf)*XYZSCAL(1,isurf) - VHY = VHINGED(2,ICL,idx_sec,isurf)*XYZSCAL(2,isurf) - VHZ = VHINGED(3,ICL,idx_sec,isurf)*XYZSCAL(3,isurf) - VSQ = VHX**2 + VHY**2 + VHZ**2 - IF(VSQ.EQ.0.0) THEN - ! default: set hinge vector along hingeline - VHX = mesh(1,1,iptr) - & + ABS(CHORDR*XHINGED(ICR,idx_sec+1,isurf)) - & - mesh(1,1,iptl) - & - ABS(CHORDL*XHINGED(ICL,idx_sec,isurf)) - VHY = mesh(2,1,iptr) - & - mesh(2,1,iptl) - VHZ = mesh(3,1,iptr) - & - mesh(3,1,iptl) - VHX = VHX*XYZSCAL(1,isurf) - VHY = VHY*XYZSCAL(2,isurf) - VHZ = VHZ*XYZSCAL(3,isurf) - VSQ = VHX**2 + VHY**2 + VHZ**2 - ENDIF - - VMOD = SQRT(VSQ) - VHINGE(1,idx_strip,N) = VHX/VMOD - VHINGE(2,idx_strip,N) = VHY/VMOD - VHINGE(3,idx_strip,N) = VHZ/VMOD - - VREFL(idx_strip,N) = REFLD(ICL,idx_sec, isurf) - - IF(XHD .GE. 0.0) THEN - PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD - PHINGE(2,idx_strip,N) = RLE(2,idx_strip) - PHINGE(3,idx_strip,N) = RLE(3,idx_strip) - ELSE - PHINGE(1,idx_strip,N) = RLE(1,idx_strip) - XHD - PHINGE(2,idx_strip,N) = RLE(2,idx_strip) - PHINGE(3,idx_strip,N) = RLE(3,idx_strip) - ENDIF - ENDIF - ENDDO - - ! Interpolate CD-CL polar defining data from input sections to strips - DO idx_coef = 1, 6 - CLCD(idx_coef,idx_strip) = (1.0-fc)* - & CLCDSEC(idx_coef,idx_sec,isurf) + - & fc*CLCDSEC(idx_coef,idx_sec+1,isurf) - END DO - ! If the min drag is zero flag the strip as no-viscous data - LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) - - - ! Set the panel (vortex) geometry data - - ! Accumulate the strip element indicies and start counting vorticies - if (idx_strip ==1) then - IJFRST(idx_strip) = 1 - else - IJFRST(idx_strip) = IJFRST(idx_strip - 1) + - & NVSTRP(idx_strip - 1) - endif - idx_vor = IJFRST(idx_strip) - NVSTRP(idx_strip) = NVC(isurf) - - ! Associate each strip with a surface - NSURFS(idx_strip) = isurf - - ! Prepare for cross section interpolation - NSL = NASEC(idx_sec , isurf) - NSR = NASEC(idx_sec+1, isurf) - - ! Interpolate claf over the section - ! CHORDC = CHORD(idx_strip) - clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL - & + FC *(CHORDR/CHORD(idx_strip))*CLAFR - - ! loop over vorticies for the strip - do idx_x = 1, nvc(isurf) - - ! Left bound vortex points - ! Y- point - RV1(2,idx_vor) = mesh(2,idx_x,idx_y) - ! Compute the panel's left side chord and angle - dc1 = sqrt((mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))**2 - & + (mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y))**2) - a1 = atan2((mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y)), - & (mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))) - ! Place vortex at panel quarter chord - RV1(1,idx_vor) = mesh(1,idx_x,idx_y) + (dc1/4.)*cos(a1) - RV1(3,idx_vor) = mesh(3,idx_x,idx_y) + (dc1/4.)*sin(a1) - - ! Right bound vortex points - ! Y- point - RV2(2,idx_vor) = mesh(2,idx_x,idx_y+1) - ! Compute the panel's right side chord and angle - dc2 = sqrt((mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))**2 - & + (mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1))**2) - a2 = atan2((mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1)), - & (mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))) - ! Place vortex at panel quarter chord - RV2(1,idx_vor) = mesh(1,idx_x,idx_y+1) + (dc2/4.)*cos(a2) - RV2(3,idx_vor) = mesh(3,idx_x,idx_y+1) + (dc2/4.)*sin(a2) - - ! Mid-point bound vortex points - ! Y- point - RV(2,idx_vor) = (mesh(2,idx_x,idx_y+1) + mesh(2,idx_x,idx_y))/2. - ! Compute the panel's mid-point chord and angle - ! Panels themselves can never be curved so just interpolate the chord - ! store as the panel chord in common block - DXV(idx_vor) = (dc1+dc2)/2. - ! However compute the mid-point angle straight up since Drela never interpolates angles - a3 = atan2(((mesh(3,idx_x+1,idx_y+1) + mesh(3,idx_x+1,idx_y))/2. - & - (mesh(3,idx_x,idx_y+1) + mesh(3,idx_x,idx_y))/2.), - & ((mesh(1,idx_x+1,idx_y+1) + mesh(1,idx_x+1,idx_y))/2. - & - (mesh(1,idx_x,idx_y+1) + mesh(1,idx_x,idx_y))/2.)) - ! Place vortex at panel quarter chord - RV(1,idx_vor) = (mesh(1,idx_x,idx_y+1)+mesh(1,idx_x,idx_y))/2. - & + (DXV(idx_x)/4.)*cos(a3) - RV(3,idx_vor) = (mesh(3,idx_x,idx_y+1)+mesh(3,idx_x,idx_y))/2. - & + (DXV(idx_x)/4.)*sin(a3) - - - ! Panel Control points - ! Y- point - ! is just the panel midpoint - RC(2,idx_vor) = RV(2,idx_vor) - ! Place the control point at the quarter chord + half chord*clafc - ! note that clafc is a scaler so is 1. for 2pi - ! use data from vortex mid-point computation - RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) - RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) - - ! Source points - ! Y- point - RS(2,idx_vor) = RV(2,idx_vor) - ! Place the source point at the half chord - ! use data from vortex mid-point computation - ! add another quarter chord to the quarter chord - RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) - RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) - - - ! Set the camber slopes for the panel - - ! Camber slope at control point - CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), - & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), - & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPER, DSDX) - - SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL - & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - - ! Camber slope at vortex mid-point - CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), - & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), - & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPER, DSDX) - - - SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL - & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - - - ! Associate the panel with it's strip's chord and component - CHORDV(idx_vor) = CHORD(idx_strip) - NSURFV(idx_vor) = LSCOMP(isurf) - - ! Enforce no penetration at the control point - LVNC(idx_vor) = .true. - - ! element inherits alpha,beta flag from surface - LVALBE(idx_vor) = LFALBE(isurf) - - ! We need to scale the control surface gains by the fraction - ! of the element on the control surface - do N = 1, NCONTROL - !scale control gain by factor 0..1, (fraction of element on control surface) - FRACLE = (XLED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) - & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / - & (DXV(idx_vor)/CHORD(idx_strip)) - - FRACTE = (XTED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) - & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / - & (DXV(idx_vor)/CHORD(idx_strip)) - - FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) - FRACTE = MIN( 1.0 , MAX( 0.0 , FRACTE ) ) - - DCONTROL(idx_vor,N) = GAINDA(N)*(FRACTE-FRACLE) - end do - - ! TE control point used only if surface sheds a wake - LVNC(idx_vor) = LFWAKE(isurf) - - ! Use the cross sections to generate the OML - ! nodal grid associated with vortex strip (aft-panel nodes) - ! NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; - ! retained in (x,z) plane at this point - - ! Store the panel mid point for the next panel in the strip - ! This gets used a lot here - xptxind1 = (mesh(1,idx_x+1,idx_y) - & - RLE1(1,idx_strip))/CHORD1(idx_strip) - - xptxind2 = (mesh(1,idx_x+1,(idx_y+1)) - & - RLE2(1,idx_strip))/CHORD2(idx_strip) - - ! Interpolate cross section on left side - CALL AKIMA( XLASEC(1,idx_sec,isurf), ZLASEC(1,idx_sec,isurf), - & NSL,xptxind1, ZL_L, DSDX ) - CALL AKIMA( XUASEC(1,idx_sec,isurf), ZUASEC(1,idx_sec,isurf), - & NSL,xptxind1, ZU_L, DSDX ) - - ! Interpolate cross section on right side - CALL AKIMA( XLASEC(1,idx_sec+1,isurf),ZLASEC(1,idx_sec+1,isurf), - & NSR, xptxind2, ZL_R, DSDX) - - CALL AKIMA( XUASEC(1,idx_sec+1,isurf),ZUASEC(1,idx_sec+1,isurf), - & NSR, xptxind2, ZU_R, DSDX) - - - ! Compute the left aft node of panel - ! X-point - XYN1(1,idx_vor) = RLE1(1,idx_strip) + - & xptxind1*CHORD1(idx_strip) - - ! Y-point - XYN1(2,idx_vor) = RLE1(2,idx_strip) - - ! Interpolate z from sections to left aft node of panel - ZL = (1.-f1)*ZL_L + f1 *ZL_R - ZU = (1.-f1)*ZU_L + f1 *ZU_R - - ! Store left aft z-point - ZLON1(idx_vor) = RLE1(3,idx_strip) + ZL*CHORD1(idx_strip) - ZUPN1(idx_vor) = RLE1(3,idx_strip) + ZU*CHORD1(idx_strip) - - ! Compute the right aft node of panel - ! X-point - XYN2(1,idx_vor) = RLE2(1,idx_strip) + - & xptxind2*CHORD2(idx_strip) - - ! Y-point - XYN2(2,idx_vor) = RLE2(2,idx_strip) - - ! Interpolate z from sections to right aft node of panel - ZL = (1.-f2)*ZL_L + f2 *ZL_R - ZU = (1.-f2)*ZU_L + f2 *ZU_R - - ! Store right aft z-point - ZLON2(idx_vor) = RLE2(3,idx_strip) + ZL*CHORD2(idx_strip) - ZUPN2(idx_vor) = RLE2(3,idx_strip) + ZU*CHORD2(idx_strip) - - - idx_vor = idx_vor + 1 - end do ! End vortex loop - idx_strip = idx_strip + 1 - end do ! End strip loop - - end do ! End section loop - - ! Compute the wetted area - sum = 0.0 - wtot = 0.0 - DO JJ = 1, NJ(isurf) - J = JFRST(isurf) + JJ-1 - ASTRP = WSTRIP(J)*CHORD(J) - SUM = SUM + ASTRP - WTOT = WTOT + WSTRIP(J) - ENDDO - SSURF(isurf) = SUM - - IF(WTOT .EQ. 0.0) THEN - CAVESURF(isurf) = 0.0 - ELSE - CAVESURF(isurf) = sum/wtot - ENDIF - ! add number of strips to the global count - NSTRIP = NSTRIP + NJ(isurf) - ! add number of of votrices to the global count - NVOR = NVOR + NK(isurf)*NJ(isurf) - - end subroutine makesurf_mesh - - integer function flatidx(idx_x, idx_y, idx_surf) + function flatidx(idx_x, idx_y, idx_surf) include 'AVL.INC' ! store MFRST and NVC in the common block integer idx_x, idx_y, idx_surf + integer flatidx flatidx = idx_x + (idx_y - 1) * NVC(idx_surf) return end function flatidx @@ -1435,6 +824,8 @@ subroutine makesurf_mesh(isurf) integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, & idx_node, idx_nodel, idx_noder, idx_node_yp1, idx_node_nx, & idx_y, nx, ny + integer flatidx + external flatidx ! Get data from common block nx = NVC(isurf) + 1 @@ -1531,8 +922,8 @@ subroutine makesurf_mesh(isurf) ! Apply the scaling and translations to the mesh as a whole - do idx_y = 1:ny - do idx_x = 1:nx + do idx_y = 1,ny + do idx_x = 1,nx do idx_dim = 1,3 idx_node = flatidx(idx_x, idx_y, idx_surf) mesh_surf(idx_dim,idx_node) = XYZSCAL(idx_dim,isurf) @@ -1667,7 +1058,7 @@ subroutine makesurf_mesh(isurf) do idx_dim = 1,3 RLE2(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node) end do - CHORD2(idx_strip) = = sqrt((mesh_surf(1,idx_node_nx) + CHORD2(idx_strip) = sqrt((mesh_surf(1,idx_node_nx) & -mesh_surf(1,idx_node))**2 + (mesh_surf(3,idx_node_nx) & -mesh_surf(3,idx_node))**2) @@ -1737,7 +1128,7 @@ subroutine makesurf_mesh(isurf) ! Set dv gains for incidence angles ! Bring over the routine for this from make surf DO N = 1, NDESIGN - CHSIN_G = ((1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) + CHSIN_G = (1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) CHCOS_G = (1.0-FC)*CHCOSL_G(N) + FC*CHCOSR_G(N) AINC_G(idx_strip,N) = (CHCOS*CHSIN_G - CHSIN*CHCOS_G) & / (CHSIN**2 + CHCOS**2) @@ -1863,13 +1254,14 @@ subroutine makesurf_mesh(isurf) ! CHORDC = CHORD(idx_strip) ! SAB: In AVL this quantity is interpolated as a product with chord ! We then divide by the chord at the strip to recover claf at the strip - ! This only works correctly for linear sections so we have to make a change - ! here to account for nonlinear(really piecewise linear) sections - ! The chord multiplication here - ! Option 1: - clafc = (1.-FC)*CLAFL + FC*CLAFR + ! This only works correctly for linear sections. For arbitrary sections + ! this can result in the claf varying across the span even when the claf + ! between two secions is equal. + ! After reaching out to Hal Youngren it is determined that it is + ! best to just interpolate claf straight up for now ! clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL ! & + FC *(CHORDR/CHORD(idx_strip))*CLAFR + clafc = (1.-fc)*clafl + fc*clafr ! loop over vorticies for the strip do idx_x = 1, nvc(isurf) @@ -1877,69 +1269,74 @@ subroutine makesurf_mesh(isurf) ! Left bound vortex points ! Y- point idx_node = flatidx(idx_x,idx_y,isurf) - RV1(2,idx_vor) = mesh(2,idx_x,idx_y) - ! Compute the panel's left side chord and angle - dc1 = sqrt((mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))**2 - & + (mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y))**2) - a1 = atan2((mesh(3,idx_x+1,idx_y) - mesh(3,idx_x,idx_y)), - & (mesh(1,idx_x+1,idx_y) - mesh(1,idx_x,idx_y))) - ! Place vortex at panel quarter chord - RV1(1,idx_vor) = mesh(1,idx_x,idx_y) + (dc1/4.)*cos(a1) - RV1(3,idx_vor) = mesh(3,idx_x,idx_y) + (dc1/4.)*sin(a1) + RV1(2,idx_vor) = mesh_surf(2,idx_node) + ! Compute the panel's left side chord and angle + dc1 = sqrt((mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))**2 + & + (mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node))**2) + a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), + & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) + ! Place vortex at panel quarter chord + RV1(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) + RV1(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) ! Right bound vortex points ! Y- point - RV2(2,idx_vor) = mesh(2,idx_x,idx_y+1) - ! Compute the panel's right side chord and angle - dc2 = sqrt((mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))**2 - & + (mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1))**2) - a2 = atan2((mesh(3,idx_x+1,idx_y+1) - mesh(3,idx_x,idx_y+1)), - & (mesh(1,idx_x+1,idx_y+1) - mesh(1,idx_x,idx_y+1))) - ! Place vortex at panel quarter chord - RV2(1,idx_vor) = mesh(1,idx_x,idx_y+1) + (dc2/4.)*cos(a2) - RV2(3,idx_vor) = mesh(3,idx_x,idx_y+1) + (dc2/4.)*sin(a2) - - ! Mid-point bound vortex points - ! Y- point - RV(2,idx_vor) = (mesh(2,idx_x,idx_y+1) + mesh(2,idx_x,idx_y))/2. - ! Compute the panel's mid-point chord and angle - ! Panels themselves can never be curved so just interpolate the chord - ! store as the panel chord in common block + idx_node_yp1 = flatidx(idx_x,idx_y+1,isurf) + RV2(2,idx_vor) = mesh_surf(2,idx_node_yp1) + ! Compute the panel's right side chord and angle + dc2 = sqrt((mesh_surf(1,idx_node_yp1+1) + & - mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_yp1+1) + & - mesh_surf(3,idx_node_yp1))**2) + a2 = atan2((mesh_surf(3,idx_node_yp1+1) - + & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - + & mesh_surf(1,idx_node_yp1))) + ! Place vortex at panel quarter chord + RV2(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) + RV2(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) + + ! Mid-point bound vortex points + ! Y- point + RV(2,idx_vor) = (mesh_surf(2,idx_node_yp1) + & + mesh_surf(2,idx_node))/2. + ! Compute the panel's mid-point chord and angle + ! Panels themselves can never be curved so just interpolate the chord + ! store as the panel chord in common block DXV(idx_vor) = (dc1+dc2)/2. - ! However compute the mid-point angle straight up since Drela never interpolates angles - a3 = atan2(((mesh(3,idx_x+1,idx_y+1) + mesh(3,idx_x+1,idx_y))/2. - & - (mesh(3,idx_x,idx_y+1) + mesh(3,idx_x,idx_y))/2.), - & ((mesh(1,idx_x+1,idx_y+1) + mesh(1,idx_x+1,idx_y))/2. - & - (mesh(1,idx_x,idx_y+1) + mesh(1,idx_x,idx_y))/2.)) - ! Place vortex at panel quarter chord - RV(1,idx_vor) = (mesh(1,idx_x,idx_y+1)+mesh(1,idx_x,idx_y))/2. - & + (DXV(idx_x)/4.)*cos(a3) - RV(3,idx_vor) = (mesh(3,idx_x,idx_y+1)+mesh(3,idx_x,idx_y))/2. - & + (DXV(idx_x)/4.)*sin(a3) - - - ! Panel Control points - ! Y- point - ! is just the panel midpoint + ! However compute the mid-point angle straight up since Drela never interpolates angles + a3 = atan2(((mesh_surf(3,idx_node_yp1+1) + & + mesh_surf(3,idx_node+1))/2.- (mesh_surf(3,idx_node_yp1) + + & mesh_surf(3,idx_node))/2.), + & ((mesh_surf(1,idx_node_yp1+1) + mesh_surf(1,idx_node+1))/2. + & - (mesh_surf(1,idx_node_yp1) + mesh_surf(1,idx_node))/2.)) + ! Place vortex at panel quarter chord + RV(1,idx_vor) = (mesh_surf(1,idx_node_yp1) + & +mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) + RV(3,idx_vor) = (mesh_surf(3,idx_node_yp1) + & +mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) + + + ! Panel Control points + ! Y- point + ! is just the panel midpoint RC(2,idx_vor) = RV(2,idx_vor) - ! Place the control point at the quarter chord + half chord*clafc - ! note that clafc is a scaler so is 1. for 2pi - ! use data from vortex mid-point computation + ! Place the control point at the quarter chord + half chord*clafc + ! note that clafc is a scaler so is 1. for 2pi + ! use data from vortex mid-point computation RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) - ! Source points - ! Y- point + ! Source points + ! Y- point RS(2,idx_vor) = RV(2,idx_vor) - ! Place the source point at the half chord - ! use data from vortex mid-point computation - ! add another quarter chord to the quarter chord + ! Place the source point at the half chord + ! use data from vortex mid-point computation + ! add another quarter chord to the quarter chord RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) ! Set the camber slopes for the panel - + ! Camber slope at control point CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) @@ -1948,10 +1345,12 @@ subroutine makesurf_mesh(isurf) & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) - SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL - & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + ! Interpolate this as is per Hal Youngren (for now) + SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +! SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL +! & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - ! Camber slope at vortex mid-point + ! Camber slope at vortex mid-point CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPEL, DSDX) @@ -1959,9 +1358,10 @@ subroutine makesurf_mesh(isurf) & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) - - SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL - & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + ! Interpolate this as is per Hal Youngren (for now) + SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +! SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL +! & + fc *(CHORDR/CHORD(idx_strip))*SLOPER ! Associate the panel with it's strip's chord and component @@ -1978,12 +1378,12 @@ subroutine makesurf_mesh(isurf) ! of the element on the control surface do N = 1, NCONTROL !scale control gain by factor 0..1, (fraction of element on control surface) - FRACLE = (XLED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) - & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / + FRACLE = (XLED(N)/CHORD(idx_strip)-((mesh_surf(1,idx_node_yp1) + & -mesh_surf(1,idx_node))/2.)/CHORD(idx_strip)) / & (DXV(idx_vor)/CHORD(idx_strip)) - FRACTE = (XTED(N)/CHORD(idx_strip)-((mesh(1,idx_x,(idx_y+1)) - & -mesh(1,idx_x,idx_y))/2.)/CHORD(idx_strip)) / + FRACTE = (XTED(N)/CHORD(idx_strip)-((mesh_surf(1,idx_node_yp1) + & -mesh_surf(1,idx_node))/2.)/CHORD(idx_strip)) / & (DXV(idx_vor)/CHORD(idx_strip)) FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) @@ -2002,10 +1402,10 @@ subroutine makesurf_mesh(isurf) ! Store the panel mid point for the next panel in the strip ! This gets used a lot here - xptxind1 = (mesh(1,idx_x+1,idx_y) + xptxind1 = (mesh_surf(1,idx_node+1) & - RLE1(1,idx_strip))/CHORD1(idx_strip) - xptxind2 = (mesh(1,idx_x+1,(idx_y+1)) + xptxind2 = (mesh_surf(1,idx_node_yp1+1) & - RLE2(1,idx_strip))/CHORD2(idx_strip) ! Interpolate cross section on left side diff --git a/src/includes/AVL.INC.in b/src/includes/AVL.INC.in index c4826a7..1cd227a 100644 --- a/src/includes/AVL.INC.in +++ b/src/includes/AVL.INC.in @@ -499,7 +499,7 @@ c COMMON /SURF_MESH_I/ & MFRST(NFMAX), ! stores the index in the MSHBLK where each surface's mesh begins - & IPTSEC(NSMAX,NFMAX), ! stores the iptloc vector for each surface + & IPTSEC(NSMAX,NFMAX) ! stores the iptloc vector for each surface REAL(kind=avl_real) MSHBLK COMMON /SURF_MESH_R/ From b283efc6dd3b4339a5cdd417c997bfe71a1291e6 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 18 Nov 2025 19:23:45 -0500 Subject: [PATCH 18/49] Implement flat mesh setting in python layer initialization. fix some fortran layer indexing bugs. runtime mesh updating still needs to be implemented --- optvl/optvl_class.py | 47 +++++++++++++++++++++++++--------------- src/amake.f | 51 ++++++++++++++++++++------------------------ src/f2py/libavl.pyf | 6 ++---- 3 files changed, 55 insertions(+), 49 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 1f46b76..764f59e 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -274,7 +274,7 @@ def __init__( self.avl.loadgeo("") else: raise ValueError("neither a geometry file nor an input options dictionary was specified") - + # todo store the default dict somewhere else # the control surface contraints get added to this array in the __init__ self.conval_idx_dict = { @@ -683,7 +683,10 @@ def check_type(key, avl_vars, given_val): else: raise RuntimeError(f"Number of specified surfaces, {num_surfs}, exceeds {self.NFMAX}. Raise NFMAX!") - + # Class variable to store the starting index of all meshes. Set to 0 for no mesh. + # We will insert entries into it for duplicate surfaces later but right now it's only for unique surfaces + self.mesh_idx_first = np.zeros(self.get_num_surfaces(),dtype=np.int32) + # Load surfaces if num_surfs > 0: surf_names = list(input_dict["surfaces"].keys()) @@ -947,6 +950,8 @@ def check_type(key, avl_vars, given_val): if "yduplicate" in surf_dict.keys(): self.avl.sdupl(idx_surf + 1, surf_dict["yduplicate"], "YDUP") + # Insert into the mesh first index array + self.mesh_idx_first = np.insert(self.mesh_idx_first,idx_surf+1,self.mesh_idx_first[idx_surf]) self.avl.CASE_I.NSURF += 1 idx_surf += 1 @@ -1074,22 +1079,36 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n nx = copy.deepcopy(mesh.shape[0]) ny = copy.deepcopy(mesh.shape[1]) + if len(iptloc) > self.NSMAX: + raise RuntimeError("Length of iptloc cannot exceed NSMAX. Raise NSMAX") + + if update_nvs: + self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 + + if update_nvc: + self.avl.SURF_GEOM_I.NVC[idx_surf] = nx-1 + # Only add +1 for Fortran indexing if we are not explictly telling the routine to use # nspans by passing in all zeros if not (iptloc == 0).all(): iptloc += 1 - # These seem to mangle the mesh up, just do a simple transpose to the correct ordering - # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0],mesh.shape[1]), order="F") - # iptloc = iptloc.ravel(order="C").reshape(iptloc.shape[::-1], order="F") - mesh = mesh.transpose((2,0,1)) + # set iptloc + self.set_avl_fort_arr("SURF_MESH_I","IPTSEC",iptloc,slicer=(idx_surf,slice(None,len(iptloc)))) - if update_nvs: - self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 + # Compute and set the mesh starting index + if idx_surf != 0: + self.mesh_idx_first[idx_surf] = self.mesh_idx_first[idx_surf-1] + 3*(self.avl.SURF_GEOM_I.NVS[idx_surf-1]+1)*(self.avl.SURF_GEOM_I.NVC[idx_surf-1]+1) - if update_nvc: - self.avl.SURF_GEOM_I.NVC[idx_surf] = nx-1 + self.set_avl_fort_arr("SURF_MESH_I","MFRST",self.mesh_idx_first[idx_surf]+1,slicer=idx_surf) + + # Reshape the mesh + # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0]*mesh.shape[1]), order="F") + mesh = mesh.transpose((1,0,2)).reshape((mesh.shape[0]*mesh.shape[1],3)) - self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing + # Set the mesh + self.set_avl_fort_arr("SURF_MESH_R","MSHBLK",mesh, slicer=(slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+nx*ny),slice(0,3))) + + self.avl.makesurf_mesh(idx_surf+1) #+1 for Fortran indexing # Ideally there would be an update_surfaces routine in Fotran to do this with meshes but for now we need to do this. def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup:float): @@ -1135,12 +1154,6 @@ def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup: self.avl.CASE_L.LSOL = False self.avl.CASE_L.LSEN = False - # def update_surfaces_mesh(self, meshes:list, iptloc:list): - # if len(meshes) != self.get_num_surfaces(): - # raise ValueError("Must provide a mesh for each surface ") - # for idx_surf in - - def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): """Sets the airfoil oml points for the specified surface and section. Computes camber lines, thickness, and oml shape from NACA 4-digit specification. diff --git a/src/amake.f b/src/amake.f index c9fcd03..4bbbead 100644 --- a/src/amake.f +++ b/src/amake.f @@ -790,12 +790,11 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, end subroutine adjust_mesh_spacing - function flatidx(idx_x, idx_y, idx_surf) + integer function flatidx(idx_x, idx_y, idx_surf) include 'AVL.INC' ! store MFRST and NVC in the common block integer idx_x, idx_y, idx_surf - integer flatidx - flatidx = idx_x + (idx_y - 1) * NVC(idx_surf) + flatidx = idx_x + (idx_y - 1) * (NVC(idx_surf)+1) return end function flatidx @@ -816,10 +815,10 @@ subroutine makesurf_mesh(isurf) real CHSIN, CHCOS, CHSINL, CHSINR, CHCOSL, CHCOSR, AINCL, AINCR, & CHORDL, CHORDR, CLAFL, CLAFR, SLOPEL, SLOPER, DXDX, ZU_L, & ZL_L, ZU_R, ZL_R, ZL, ZR, SUM, WTOT, ASTRP - REAL CHSINL_G(NGMAX),CHCOSL_G(NGMAX), + real CHSINL_G(NGMAX),CHCOSL_G(NGMAX), & CHSINR_G(NGMAX),CHCOSR_G(NGMAX) - REAL XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) - INTEGER ISCONL(NDMAX), ISCONR(NDMAX) + real XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) + integer ISCONL(NDMAX), ISCONR(NDMAX) real mesh_surf(3,(NVC(isurf)+1)*(NVS(isurf)+1)) integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, & idx_node, idx_nodel, idx_noder, idx_node_yp1, idx_node_nx, @@ -845,7 +844,7 @@ subroutine makesurf_mesh(isurf) & NSPANS(idx_sec-1,isurf) end do else - print *, '* Provide NSPANS or IPTLOC. (Hint: Run adjust_mesh_& + print *, '* Provide NSPANS or IPTSEC. (Hint: Run adjust_mesh_& & spacing)' stop end if @@ -857,7 +856,7 @@ subroutine makesurf_mesh(isurf) & isurf end if - ! Get the mesh from the the common block + ! Get the mesh for this surface from the the common block mesh_surf = MSHBLK(:,MFRST(isurf):MFRST(isurf)+(nx*ny)-1) ! Perform input checks from makesurf @@ -922,10 +921,10 @@ subroutine makesurf_mesh(isurf) ! Apply the scaling and translations to the mesh as a whole - do idx_y = 1,ny - do idx_x = 1,nx - do idx_dim = 1,3 - idx_node = flatidx(idx_x, idx_y, idx_surf) + do idx_y = 1,ny + do idx_x = 1,nx + do idx_dim = 1,3 + idx_node = flatidx(idx_x, idx_y, isurf) mesh_surf(idx_dim,idx_node) = XYZSCAL(idx_dim,isurf) & *mesh_surf(idx_dim,idx_node) + XYZTRAN(idx_dim,isurf) end do @@ -1135,7 +1134,7 @@ subroutine makesurf_mesh(isurf) ENDDO ! We have to now setup any control surfaces we defined for this section - ! Bring over the routine for this from Drela + ! Bring over the routine for this from makesurf DO N = 1, NCONTROL ICL = ISCONL(N) ICR = ISCONR(N) @@ -1161,18 +1160,17 @@ subroutine makesurf_mesh(isurf) GAINDA(N) = GAIND(ICL,idx_sec ,isurf)*(1.0-FC) & + GAIND(ICR,idx_sec+1,isurf)* FC - ! SAB Note: This iterpolation ensures that the hinge line is - ! is linear which I think it is an ok assumption for arbitrary wings - ! as long as the user is aware + ! SAB Note: This interpolation ensures that the hinge line is + ! is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware ! A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC IF(XHD.GE.0.0) THEN - ! TE control surface, with hinge at XHD + ! TE control surface, with hinge at XHD XLED(N) = XHD XTED(N) = CHORD(idx_strip) ELSE - ! LE control surface, with hinge at -XHD + ! LE control surface, with hinge at -XHD XLED(N) = 0.0 XTED(N) = -XHD ENDIF @@ -1182,12 +1180,9 @@ subroutine makesurf_mesh(isurf) VHZ = VHINGED(3,ICL,idx_sec,isurf)*XYZSCAL(3,isurf) VSQ = VHX**2 + VHY**2 + VHZ**2 IF(VSQ.EQ.0.0) THEN - ! default: set hinge vector along hingeline - idx_nodel = flatidx(1,iptl,isurf) - idx_noder = flatidx(1,iptr,isurf) + ! default: set hinge vector along hingeline ! We are just setting the hinge line across the section - ! this assumes the hinge is linear even for a nonlinear - ! wing which I assume is a fair assumption + ! this assumes the hinge is linear even for a nonlinear wing VHX = mesh_surf(1,idx_noder) & + ABS(CHORDR*XHINGED(ICR,idx_sec+1,isurf)) & - mesh_surf(1,idx_nodel) @@ -1234,7 +1229,7 @@ subroutine makesurf_mesh(isurf) ! Set the panel (vortex) geometry data ! Accumulate the strip element indicies and start counting vorticies - if (idx_strip ==1) then + if (idx_strip .eq. 1) then IJFRST(idx_strip) = 1 else IJFRST(idx_strip) = IJFRST(idx_strip - 1) + @@ -1243,15 +1238,16 @@ subroutine makesurf_mesh(isurf) idx_vor = IJFRST(idx_strip) NVSTRP(idx_strip) = NVC(isurf) - ! Associate each strip with a surface + ! Associate the strip with the surface NSURFS(idx_strip) = isurf ! Prepare for cross section interpolation NSL = NASEC(idx_sec , isurf) NSR = NASEC(idx_sec+1, isurf) + ! CHORDC = CHORD(idx_strip) + ! Interpolate claf over the section - ! CHORDC = CHORD(idx_strip) ! SAB: In AVL this quantity is interpolated as a product with chord ! We then divide by the chord at the strip to recover claf at the strip ! This only works correctly for linear sections. For arbitrary sections @@ -1320,7 +1316,7 @@ subroutine makesurf_mesh(isurf) ! is just the panel midpoint RC(2,idx_vor) = RV(2,idx_vor) ! Place the control point at the quarter chord + half chord*clafc - ! note that clafc is a scaler so is 1. for 2pi + ! note that clafc is a scaler so is 1. is for 2pi ! use data from vortex mid-point computation RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) @@ -1363,7 +1359,6 @@ subroutine makesurf_mesh(isurf) ! SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL ! & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - ! Associate the panel with it's strip's chord and component CHORDV(idx_vor) = CHORD(idx_strip) NSURFV(idx_vor) = LSCOMP(isurf) diff --git a/src/f2py/libavl.pyf b/src/f2py/libavl.pyf index 81fa70a..50c9845 100644 --- a/src/f2py/libavl.pyf +++ b/src/f2py/libavl.pyf @@ -135,10 +135,8 @@ python module libavl ! in real*8, intent(inout) :: asys(jemax,jemax) end subroutine get_system_matrix - subroutine makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) ! in :libavl:amake.f - integer :: isurf, nx, ny - integer :: iptloc(nsecsurf) - real*8 :: mesh(3,nx,ny) + subroutine makesurf_mesh(isurf) ! in :libavl:amake.f + integer :: isurf end subroutine makesurf_mesh subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc, nsecsurf) ! in :libavl:amake.f From 0967bce73138a83859f5b5b9e9dd8bdd43103892 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Fri, 21 Nov 2025 17:10:56 -0500 Subject: [PATCH 19/49] Implement new normal calcs for custom meshes --- optvl/optvl_class.py | 52 +--- src/amake.f | 450 +++++++++++++++++++++++++++------- src/aoper.f | 6 +- src/avl.f | 6 +- src/includes/AVL.INC.in | 8 + src/includes/AVL_ad_seeds.inc | 22 +- src/sgutil.f | 2 +- 7 files changed, 402 insertions(+), 144 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 764f59e..36bc3c5 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -945,12 +945,13 @@ def check_type(key, avl_vars, given_val): self.avl.adjust_mesh_spacing(idx_surf+1,surf_dict["mesh"].transpose((2, 0, 1)),surf_dict["iptloc"]) surf_dict["iptloc"] = surf_dict["iptloc"] - 1 self.set_mesh(idx_surf, surf_dict["mesh"],surf_dict["iptloc"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering + self.avl.makesurf_mesh(idx_surf + 1) #+1 for Fortran indexing else: self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing if "yduplicate" in surf_dict.keys(): self.avl.sdupl(idx_surf + 1, surf_dict["yduplicate"], "YDUP") - # Insert into the mesh first index array + # Insert duplicate into the mesh first index array self.mesh_idx_first = np.insert(self.mesh_idx_first,idx_surf+1,self.mesh_idx_first[idx_surf]) self.avl.CASE_I.NSURF += 1 idx_surf += 1 @@ -1101,58 +1102,15 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n self.set_avl_fort_arr("SURF_MESH_I","MFRST",self.mesh_idx_first[idx_surf]+1,slicer=idx_surf) - # Reshape the mesh + # Reshape the mesh # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0]*mesh.shape[1]), order="F") mesh = mesh.transpose((1,0,2)).reshape((mesh.shape[0]*mesh.shape[1],3)) # Set the mesh self.set_avl_fort_arr("SURF_MESH_R","MSHBLK",mesh, slicer=(slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+nx*ny),slice(0,3))) - self.avl.makesurf_mesh(idx_surf+1) #+1 for Fortran indexing - - # Ideally there would be an update_surfaces routine in Fotran to do this with meshes but for now we need to do this. - def update_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, ydup:float): - # nx = copy.deepcopy(mesh.shape[0]) - # ny = copy.deepcopy(mesh.shape[1]) - - # reset the counters before starting the first surface - if idx_surf == 0: - self.avl.CASE_I.NSTRIP = 0 - self.avl.CASE_I.NVOR = 0 - - # Only add +1 for Fortran indexing if we are not explictly telling the routine to use - # nspans by passing in all zeros - if not (iptloc == 0).all(): - iptloc += 1 - # These seem to mangle the mesh up, just do a simple transpose to the correct ordering - # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0],mesh.shape[1]), order="F") - # iptloc = iptloc.ravel(order="C").reshape(iptloc.shape[::-1], order="F") - mesh = mesh.transpose((2,0,1)) - - # if update_nvs: - # self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 - - # if update_nvc: - # self.avl.SURF_GEOM_I.NVC[idx_surf] = nx-1 - - if idx_surf != 0: - if self.avl.SURF_GEOM_L.LDUPL[idx_surf-1]: - print(f"Surface {idx_surf} is a duplicated surface!") - else: - self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing - else: - self.avl.makesurf_mesh(idx_surf+1, mesh, iptloc) #+1 for Fortran indexing - - if self.avl.SURF_GEOM_L.LDUPL[idx_surf]: - self.avl.sdupl(idx_surf + 1, ydup, "YDUP") - - # Reset AVL solver upon finishing the last surface - if (idx_surf == (self.get_num_surfaces()-1)): - self.avl.CASE_L.LAIC = False - self.avl.CASE_L.LSRD = False - self.avl.CASE_L.LVEL = False - self.avl.CASE_L.LSOL = False - self.avl.CASE_L.LSEN = False + # Flag surface as using mesh geometry + self.avl.SURF_MESH_L.LSURFMSH[idx_surf] = True def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): """Sets the airfoil oml points for the specified surface and section. Computes camber lines, thickness, and oml shape from diff --git a/src/amake.f b/src/amake.f index 4bbbead..2b85949 100644 --- a/src/amake.f +++ b/src/amake.f @@ -710,9 +710,9 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, end if ! NOTE-SB: I don't think we need this - ! I originally included it to be more consistent with Drela + ! I originally included it to be more consistent with AVL ! The prior routine only considers the y distance while - ! Drela considers y and z. However, the above routine appears + ! AVL considers y and z. However, the above routine appears ! to work fine on its own and running this after appears to ! cause issues. @@ -726,7 +726,7 @@ subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, ! yzlen(idx_sec) = yzlen(idx_sec-1) + sqrt(dy*dy + dz*dz) ! end do -! ! Now do the Drela fudging routine to ensure the sections don't split panels +! ! Now do the AVL fudging routine to ensure the sections don't split panels ! ! Find node nearest each section ! do isec = 2, NSEC(isurf)-1 @@ -801,30 +801,34 @@ end function flatidx subroutine makesurf_mesh(isurf) c-------------------------------------------------------------- c Sets up all stuff for surface ISURF, -C using info from configuration input file +C using info from configuration input C and the given mesh coordinate array. c-------------------------------------------------------------- INCLUDE 'AVL.INC' ! input/output integer isurf - - ! working variables - real m1, m2, m3, f1, f2, dc1, dc2, dc, a1, a2, a3, xptxind1 + + ! working variables (AVL original) PARAMETER (KCMAX=50, & KSMAX=500) - real CHSIN, CHCOS, CHSINL, CHSINR, CHCOSL, CHCOSR, AINCL, AINCR, + REAL CHSIN, CHCOS, CHSINL, CHSINR, CHCOSL, CHCOSR, AINCL, AINCR, & CHORDL, CHORDR, CLAFL, CLAFR, SLOPEL, SLOPER, DXDX, ZU_L, & ZL_L, ZU_R, ZL_R, ZL, ZR, SUM, WTOT, ASTRP - real CHSINL_G(NGMAX),CHCOSL_G(NGMAX), - & CHSINR_G(NGMAX),CHCOSR_G(NGMAX) - real XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) - integer ISCONL(NDMAX), ISCONR(NDMAX) + REAL CHSINL_G(NGMAX),CHCOSL_G(NGMAX), + & CHSINR_G(NGMAX),CHCOSR_G(NGMAX), + & XLED(NDMAX), XTED(NDMAX), GAINDA(NDMAX) + INTEGER ISCONL(NDMAX), ISCONR(NDMAX) + + ! working variables (OptVL additions) + real m1, m2, m3, f1, f2, fc, dc1, dc2, dc, a1, a2, a3, xptxind1, + & xptxind2 real mesh_surf(3,(NVC(isurf)+1)*(NVS(isurf)+1)) integer idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, & idx_node, idx_nodel, idx_noder, idx_node_yp1, idx_node_nx, - & idx_y, nx, ny + & idx_node_nx_yp1, idx_y, nx, ny + + ! functions integer flatidx - external flatidx ! Get data from common block nx = NVC(isurf) + 1 @@ -1052,33 +1056,36 @@ subroutine makesurf_mesh(isurf) & -mesh_surf(3,idx_node))**2) ! Strip right side - idx_node = flatidx(1,idx_y+1,isurf) - idx_node_nx = flatidx(nx,idx_y+1,isurf) + idx_node_yp1 = flatidx(1,idx_y+1,isurf) + idx_node_nx_yp1 = flatidx(nx,idx_y+1,isurf) do idx_dim = 1,3 - RLE2(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node) + RLE2(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node_yp1) end do - CHORD2(idx_strip) = sqrt((mesh_surf(1,idx_node_nx) - & -mesh_surf(1,idx_node))**2 + (mesh_surf(3,idx_node_nx) - & -mesh_surf(3,idx_node))**2) + CHORD2(idx_strip) = sqrt((mesh_surf(1,idx_node_nx_yp1) + & -mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_nx_yp1) + & -mesh_surf(3,idx_node_yp1))**2) ! Strip mid-point do idx_dim = 1,3 - ! Since the strips are linear we can just interpolate + ! Since the strips are linear SPANWISE we can just interpolate RLE(idx_dim,idx_strip) = (RLE1(idx_dim,idx_strip) & + RLE2(idx_dim,idx_strip))/2. - ! RLE(idx_dim,idx_strip) = (mesh(idx_dim,1,idx_y+1)+mesh(idx_dim,1,idx_y))/2 end do - ! Since the strips are linear we can just interpolate + ! The strips are not necessarily linear chord wise but by definition the chord value is + ! so we can interpolate CHORD(idx_strip) = (CHORD1(idx_strip)+CHORD2(idx_strip))/2. -! m1 = ((mesh(1,nx,idx_y+1)+mesh(1,nx,idx_y))/2) - -! & ((mesh(1,1,idx_y+1)+mesh(1,1,idx_y))/2) -! m3 = ((mesh(3,nx,idx_y+1)+mesh(3,nx,idx_y))/2) - -! & ((mesh(3,1,idx_y+1)+mesh(3,1,idx_y))/2) -! CHORD(idx_strip) = sqrt(m1**2 + m3**2) + + ! Strip geometric incidence angle at the mid-point + ! This is strip incidence angle is computed from the LE and TE points + ! of the given geometry and is completely independent of AINC + ! This quantity is needed to correctly handle nonplanar meshes + GINCSTRIP(idx_strip) = atan2(((mesh_surf(3,idx_node_nx) + & + mesh_surf(3,idx_node_nx_yp1))/2.- (mesh_surf(3,idx_node) + + & mesh_surf(3,idx_node_yp1))/2.), + & ((mesh_surf(1,idx_node_nx) + mesh_surf(1,idx_node_nx_yp1))/2. + & - (mesh_surf(1,idx_node) + mesh_surf(1,idx_node_yp1))/2.)) ! Strip width (leading edge) - idx_node = flatidx(1,idx_y,isurf) - idx_node_yp1 = flatidx(1,idx_y+1,isurf) m2 = mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_node) m3 = mesh_surf(3,idx_node_yp1)-mesh_surf(3,idx_node) WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) @@ -1098,8 +1105,6 @@ subroutine makesurf_mesh(isurf) ! LINEAR interpolation over the section: left, right, and midpoint idx_nodel = flatidx(1,iptl,isurf) idx_noder = flatidx(1,iptr,isurf) - idx_node = flatidx(1,idx_y,isurf) - idx_node_yp1 = flatidx(1,idx_y+1,isurf) f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) @@ -1304,6 +1309,8 @@ subroutine makesurf_mesh(isurf) & mesh_surf(3,idx_node))/2.), & ((mesh_surf(1,idx_node_yp1+1) + mesh_surf(1,idx_node+1))/2. & - (mesh_surf(1,idx_node_yp1) + mesh_surf(1,idx_node))/2.)) + ! project the panel chord onto the strip chord + DXSTRPV(idx_vor) = DXV(idx_vor)*cos(a3-GINCSTRIP(idx_strip)) ! Place vortex at panel quarter chord RV(1,idx_vor) = (mesh_surf(1,idx_node_yp1) & +mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) @@ -1395,13 +1402,13 @@ subroutine makesurf_mesh(isurf) ! NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; ! retained in (x,z) plane at this point - ! Store the panel mid point for the next panel in the strip + ! Store the panel LE mid point for the next panel in the strip ! This gets used a lot here - xptxind1 = (mesh_surf(1,idx_node+1) - & - RLE1(1,idx_strip))/CHORD1(idx_strip) + xptxind1 = ((mesh_surf(1,idx_node+1)+mesh_surf(1,idx_node_yp1+1)) + & /2 - RLE(1,idx_strip))/CHORD(idx_strip) - xptxind2 = (mesh_surf(1,idx_node_yp1+1) - & - RLE2(1,idx_strip))/CHORD2(idx_strip) +! xptxind2 = (mesh_surf(1,idx_node_yp1+1) +! & - RLE2(1,idx_strip))/CHORD2(idx_strip) ! Interpolate cross section on left side CALL AKIMA( XLASEC(1,idx_sec,isurf), ZLASEC(1,idx_sec,isurf), @@ -1411,10 +1418,10 @@ subroutine makesurf_mesh(isurf) ! Interpolate cross section on right side CALL AKIMA( XLASEC(1,idx_sec+1,isurf),ZLASEC(1,idx_sec+1,isurf), - & NSR, xptxind2, ZL_R, DSDX) + & NSR, xptxind1, ZL_R, DSDX) CALL AKIMA( XUASEC(1,idx_sec+1,isurf),ZUASEC(1,idx_sec+1,isurf), - & NSR, xptxind2, ZU_R, DSDX) + & NSR, xptxind1, ZU_R, DSDX) ! Compute the left aft node of panel @@ -1436,7 +1443,7 @@ subroutine makesurf_mesh(isurf) ! Compute the right aft node of panel ! X-point XYN2(1,idx_vor) = RLE2(1,idx_strip) + - & xptxind2*CHORD2(idx_strip) + & xptxind1*CHORD2(idx_strip) ! Y-point XYN2(2,idx_vor) = RLE2(2,idx_strip) @@ -1479,49 +1486,6 @@ subroutine makesurf_mesh(isurf) NVOR = NVOR + NK(isurf)*NJ(isurf) end subroutine makesurf_mesh - -! subroutine update_surface_mesh_HACK(isurf,mesh,nx,ny,iptloc, -! & nsecsurf,lcount, lcall) -! c-------------------------------------------------------------- -! c HACK: This routine is a temporary solution that combines -! c the functionality of makesurf_mesh with update_surfaces. -! c note that unlike update_surfaces it can only update one -! c surface at a time and requires the mesh for that surface -! c ber provided as input. There is also a flag that tells -! c the routine whether to reset the counters or not. This -! c routine is a hack until I can find a better way to store -! c meshes in the Fortran layer without flattening them. -! c-------------------------------------------------------------- -! include 'AVL.INC' -! integer isurf, nx, ny, nsecsurf -! real mesh(3,nx,ny) -! integer iptloc(nsecsurf) -! logical lcount, lcall - -! if (lcount) then -! NSTRIP = 0 -! NVOR = 0 -! end if - - -! call makesurf_mesh(isurf, mesh, nx, ny, iptloc, nsecsurf) - -! if(ldupl(isurf)) then -! call sdupl(isurf,ydupl(isurf),'ydup') -! endif - -! if (lcall) then -! CALL ENCALC - -! LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it -! LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them -! LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it -! LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists -! LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists -! end if - -! end subroutine update_surfaces_mesh - subroutine update_surfaces() c-------------------------------------------------------------- @@ -1548,9 +1512,17 @@ subroutine update_surfaces() ! it was probably duplicated from the previous one cycle end if - call makesurf(ISURF) + if (lsurfmsh(isurf)) then + call makesurf_mesh(ISURF) + else + call makesurf(ISURF) + end if else - call makesurf(ISURF) + if (lsurfmsh(isurf)) then + call makesurf_mesh(ISURF) + else + call makesurf(ISURF) + end if endif if(ldupl(isurf)) then @@ -1558,7 +1530,8 @@ subroutine update_surfaces() endif end do - CALL ENCALC + !CALL ENCALC + CALL ENCALC2 LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them @@ -1698,7 +1671,8 @@ subroutine update_bodies() endif end do - CALL ENCALC + !CALL ENCALC + CALL ENCALC2 LAIC = .FALSE. LSRD = .FALSE. @@ -1889,6 +1863,7 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) RLE(2,JJI) = -RLE(2,JJ) + YOFF RLE(3,JJI) = RLE(3,JJ) CHORD(JJI) = CHORD(JJ) + GINCSTRIP(JJI) = GINCSTRIP(JJ) WSTRIP(JJI) = WSTRIP(JJ) TANLE(JJI) = -TANLE(JJ) AINC (JJI) = AINC(JJ) @@ -1954,6 +1929,7 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) SLOPEC(III) = SLOPEC(II) SLOPEV(III) = SLOPEV(II) DXV(III) = DXV(II) + DXSTRPV(III) = DXSTRPV(II) CHORDV(III) = CHORDV(II) NSURFV(III) = LSCOMP(NNI) LVALBE(III) = LVALBE(II) @@ -2327,3 +2303,303 @@ SUBROUTINE ENCALC RETURN END ! ENCALC + + + + + SUBROUTINE ENCALC2 +C +C...PURPOSE To calculate the normal vectors for the strips, +C the horseshoe vortices, and the control points. +C Assuming arbitrary point cloud geometry +C Incorporates surface deflections. +C +C...INPUT NVOR Number of vortices +C X1 Coordinates of endpoint #1 of the vortices +C X2 Coordinates of endpoint #2 of the vortices +C SLOPEV Slope at bound vortices +C SLOPEC Slope at control points +C NSTRIP Number of strips +C IJFRST Index of first element in strip +C NVSTRP No. of vortices in strip +C AINC Angle of incidence of strip +C LDES include design-variable deflections if TRUE +C +C...OUTPUT ENC(3) Normal vector at control point +C ENV(3) Normal vector at bound vortices +C ENSY, ENSZ Strip normal vector (ENSX=0) +C LSTRIPOFF Non-used strip (T) (below z=ZSYM) +C +C...COMMENTS +C + INCLUDE 'AVL.INC' +C + REAL EP(3), EQ(3), ES(3), EB(3), EC(3), ECXB(3) + REAL EC_G(3,NDMAX), ECXB_G(3) + + real(kind=avl_real) :: dchstrip, DXT, DYT, DZT +C +C...Calculate the normal vector at control points and bound vortex midpoints +C + DO 10 J = 1, NSTRIP +C +C...Calculate normal vector for the strip (normal to X axis) + ! we can't just interpolate this anymore given that + ! the strip is no longer necessarily linear chordwise + + ! We want the spanwise unit vector for the strip at the + ! chordwise location specified by SAXFR (usually set to 0.25) + ! Loop over all panels in the strip until we find the one that contains + ! the SAXFR position in it's projected chord. Since the panels themselves are still linear + ! we can just use the bound vortex unit vector of that panel as + ! the spanwise unit vector of the strip at SAXFR + + ! SAB: This is slow, find a better way to do this + dchstrip = 0.0 + searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) + dchstrip = dchstrip+DXSTRPV(i) + if (dchstrip .ge. CHORD(J)*SAXFR) then + exit searchSAXFR + end if + end do searchSAXFR + + ! print *, "I", I + + ! compute the spanwise unit vector for Vperp def + DXT = RV2(1,I)-RV1(1,I) + DYT = RV2(2,I)-RV1(2,I) + DZT = RV2(3,I)-RV1(3,I) + XSREF(J) = RV(1,I) + YSREF(J) = RV(2,I) + ZSREF(J) = RV(3,I) + + ! print *, "DVT", DYT + ! print *, "RV2(2,I)-RV1(2,I)", RV2(2,I)-RV1(2,I) + ! print *, "RV2(2,I)", RV2(2,I) + ! print *, "RV1(2,I)", RV1(2,I) + ! print *, "NSTRIP", NSTRIP + ! print *, "J", J + ESS(1,J) = DXT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) + ESS(2,J) = DYT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) + ESS(3,J) = DZT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) + + ! Treffz plane normals + ENSY(J) = -DZT/SQRT(DYT*DYT + DZT*DZT) + ENSZ(J) = DYT/SQRT(DYT*DYT + DZT*DZT) + + ES(1) = 0. + ES(2) = ENSY(J) + ES(3) = ENSZ(J) +C + LSTRIPOFF(J) = .FALSE. +C + NV = NVSTRP(J) + DO 105 II = 1, NV +C + I = IJFRST(J) + (II-1) +C + DO N = 1, NCONTROL + ENV_D(1,I,N) = 0. + ENV_D(2,I,N) = 0. + ENV_D(3,I,N) = 0. + ENC_D(1,I,N) = 0. + ENC_D(2,I,N) = 0. + ENC_D(3,I,N) = 0. + ENDDO +C + DO N = 1, NDESIGN + ENV_G(1,I,N) = 0. + ENV_G(2,I,N) = 0. + ENV_G(3,I,N) = 0. + ENC_G(1,I,N) = 0. + ENC_G(2,I,N) = 0. + ENC_G(3,I,N) = 0. + ENDDO +C +C...Define unit vector along bound leg + DXB = RV2(1,I)-RV1(1,I) ! right h.v. pt - left h.v. pt + DYB = RV2(2,I)-RV1(2,I) + DZB = RV2(3,I)-RV1(3,I) + EMAG = SQRT(DXB**2 + DYB**2 + DZB**2) + EB(1) = DXB/EMAG + EB(2) = DYB/EMAG + EB(3) = DZB/EMAG +C +C...Define direction of normal vector at control point + + ! First start by combining the contributions to the panel + ! incidence from AVL incidence and camberline slope variables + ! these are not actual geometric transformations of the mesh + ! but rather further modifications to the chordwise vector that + ! will get used to compute normals + ANG = AINC(J) - ATAN(SLOPEC(I)) +C--------- add design-variable contribution to angle + DO N = 1, NDESIGN + ANG = ANG + AINC_G(J,N)*DELDES(N) + ENDDO +C + ! now we compute the chordwise panel vector + ! note that panel's chordwise vector has contributions + ! from both the geometry itself and the incidence modification + ! from the AVL AINC and camber slope variables + + ! To avoid storing uncessary info in the common block + ! Get the geometric chordwise vector using RV and RC which should + ! be located in the same plane given that each individual panel is a + ! plane + + ! Note that like in AVL the sin of the incidence is projected + ! to the strip's normal in the YZ plane (Treffz plane) + ! which is ES(2) and ES(3) computed earlier + SINC = SIN(ANG) + COSC = COS(ANG) + EC(1) = COSC + (RC(1,I)-RV(1,I)) + EC(2) = -SINC*ES(2) + (RC(2,I)-RV(2,I)) + EC(3) = -SINC*ES(3) + (RC(3,I)-RV(3,I)) + + DO N = 1, NDESIGN + EC_G(1,N) = -SINC *AINC_G(J,N) + EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) + EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) + ENDDO +C +C...Normal vector is perpendicular to camberline vector and to the bound leg + CALL CROSS(EC,EB,ECXB) + EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) + IF(EMAG.NE.0.0) THEN + ENC(1,I) = ECXB(1)/EMAG + ENC(2,I) = ECXB(2)/EMAG + ENC(3,I) = ECXB(3)/EMAG + DO N = 1, NDESIGN + CALL CROSS(EC_G(1,N),EB,ECXB_G) + EMAG_G = ENC(1,I)*ECXB_G(1) + & + ENC(2,I)*ECXB_G(2) + & + ENC(3,I)*ECXB_G(3) + ENC_G(1,I,N) = (ECXB_G(1) - ENC(1,I)*EMAG_G)/EMAG + ENC_G(2,I,N) = (ECXB_G(2) - ENC(2,I)*EMAG_G)/EMAG + ENC_G(3,I,N) = (ECXB_G(3) - ENC(3,I)*EMAG_G)/EMAG + ENDDO + ELSE + ENC(1,I) = ES(1) + ENC(2,I) = ES(2) + ENC(3,I) = ES(3) + ENDIF + +C +C +C...Define direction of normal vector at vortex mid-point. + + ! This section is identical to the normal vector at the control + ! point. The only different is that the AVL camberline slope + ! is taken at the bound vortex point rather than the control point + ! the geometric contributions to the normal vector at both of these + ! point is identical as the lie in the plane of the same panel. + ANG = AINC(J) - ATAN(SLOPEV(I)) + +C--------- add design-variable contribution to angle + DO N = 1, NDESIGN + ANG = ANG + AINC_G(J,N)*DELDES(N) + ENDDO + +C + SINC = SIN(ANG) + COSC = COS(ANG) + EC(1) = COSC + (RC(1,I)-RV(1,I)) + EC(2) = -SINC*ES(2) + (RC(2,I)-RV(2,I)) + EC(3) = -SINC*ES(3) + (RC(3,I)-RV(3,I)) + DO N = 1, NDESIGN + EC_G(1,N) = -SINC *AINC_G(J,N) + EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) + EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) + ENDDO +C +C...Normal vector is perpendicular to camberline vector and to the bound leg + CALL CROSS(EC,EB,ECXB) + EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) + IF(EMAG.NE.0.0) THEN + ENV(1,I) = ECXB(1)/EMAG + ENV(2,I) = ECXB(2)/EMAG + ENV(3,I) = ECXB(3)/EMAG + DO N = 1, NDESIGN + CALL CROSS(EC_G(1,N),EB,ECXB_G) + EMAG_G = ENC(1,I)*ECXB_G(1) + & + ENC(2,I)*ECXB_G(2) + & + ENC(3,I)*ECXB_G(3) + ENV_G(1,I,N) = (ECXB_G(1) - ENV(1,I)*EMAG_G)/EMAG + ENV_G(2,I,N) = (ECXB_G(2) - ENV(2,I)*EMAG_G)/EMAG + ENV_G(3,I,N) = (ECXB_G(3) - ENV(3,I)*EMAG_G)/EMAG + ENDDO + ELSE + ENV(1,I) = ES(1) + ENV(2,I) = ES(2) + ENV(3,I) = ES(3) + ENDIF +C +C +ccc write(*,*) i, dcontrol(i,1), dcontrol(i,2) +C +C======================================================= +C-------- rotate normal vectors for control surface + ! this is a pure rotation of the normal vector + ! the mesh geometric contribution is already accounted for + DO 100 N = 1, NCONTROL +C +C---------- skip everything if this element is unaffected by control variable N + IF(DCONTROL(I,N).EQ.0.0) GO TO 100 +C + ANG = DTR*DCONTROL(I,N)*DELCON(N) + ANG_DDC = DTR*DCONTROL(I,N) +C + COSD = COS(ANG) + SIND = SIN(ANG) +C +C---------- EP = normal-vector component perpendicular to hinge line + ENDOT = DOT(ENC(1,I),VHINGE(1,J,N)) + EP(1) = ENC(1,I) - ENDOT*VHINGE(1,J,N) + EP(2) = ENC(2,I) - ENDOT*VHINGE(2,J,N) + EP(3) = ENC(3,I) - ENDOT*VHINGE(3,J,N) +C---------- EQ = unit vector perpendicular to both EP and hinge line + CALL CROSS(VHINGE(1,J,N),EP,EQ) +C +C---------- rotated vector would consist of sin,cos parts from EP and EQ, +C- with hinge-parallel component ENDOT restored +cc ENC(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) +cc ENC(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) +cc ENC(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) +C +C---------- linearize about zero deflection (COSD=1, SIND=0) + ENC_D(1,I,N) = ENC_D(1,I,N) + EQ(1)*ANG_DDC + ENC_D(2,I,N) = ENC_D(2,I,N) + EQ(2)*ANG_DDC + ENC_D(3,I,N) = ENC_D(3,I,N) + EQ(3)*ANG_DDC +C +C +C---------- repeat for ENV vector +C +C---------- EP = normal-vector component perpendicular to hinge line + ENDOT = DOT(ENV(1,I),VHINGE(1,J,N)) + EP(1) = ENV(1,I) - ENDOT*VHINGE(1,J,N) + EP(2) = ENV(2,I) - ENDOT*VHINGE(2,J,N) + EP(3) = ENV(3,I) - ENDOT*VHINGE(3,J,N) +C---------- EQ = unit vector perpendicular to both EP and hinge line + CALL CROSS(VHINGE(1,J,N),EP,EQ) +C +C---------- rotated vector would consist of sin,cos parts from EP and EQ, +C- with hinge-parallel component ENDOT restored +cc ENV(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) +cc ENV(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) +cc ENV(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) +C +C---------- linearize about zero deflection (COSD=1, SIND=0) + ENV_D(1,I,N) = ENV_D(1,I,N) + EQ(1)*ANG_DDC + ENV_D(2,I,N) = ENV_D(2,I,N) + EQ(2)*ANG_DDC + ENV_D(3,I,N) = ENV_D(3,I,N) + EQ(3)*ANG_DDC + 100 CONTINUE + 101 CONTINUE +C + 105 CONTINUE + 10 CONTINUE +C + LENC = .TRUE. +C + RETURN + END ! ENCALC2 \ No newline at end of file diff --git a/src/aoper.f b/src/aoper.f index b65f03b..c039e82 100644 --- a/src/aoper.f +++ b/src/aoper.f @@ -1618,7 +1618,8 @@ SUBROUTINE OPTGET ENDIF C SAXFR = MAX( 0.0 , MIN(1.0,RINPUT(1)) ) - CALL ENCALC + ! CALL ENCALC + CALL ENCALC2 CALL AERO C C--------------------------------- @@ -1635,7 +1636,8 @@ SUBROUTINE OPTGET ENDIF C VRCORE = MAX( 0.0 , MIN(1.0,RINPUT(1)) ) - CALL ENCALC + ! CALL ENCALC + CALL ENCALC2 LAIC = .FALSE. LSRD = .FALSE. LSOL = .FALSE. diff --git a/src/avl.f b/src/avl.f index 0d2b8ca..8e42153 100644 --- a/src/avl.f +++ b/src/avl.f @@ -96,7 +96,8 @@ SUBROUTINE AVL C----- process geometry to define strip and vortex data LPLTNEW = .TRUE. ! TODO remove? - CALL ENCALC + ! CALL ENCALC + CALL ENCALC2 C C----- initialize state CALL VARINI @@ -455,7 +456,8 @@ SUBROUTINE loadGEO(geom_file) C C----- process geometry to define strip and vortex data LPLTNEW = .TRUE. - CALL ENCALC + ! CALL ENCALC + CALL ENCALC2 C C----- initialize state C CALL VARINI diff --git a/src/includes/AVL.INC.in b/src/includes/AVL.INC.in index 1cd227a..033c549 100644 --- a/src/includes/AVL.INC.in +++ b/src/includes/AVL.INC.in @@ -505,6 +505,10 @@ c COMMON /SURF_MESH_R/ & MSHBLK(3, 4*NVMAX) ! block to store all surface meshes + LOGICAL LSURFMSH + COMMON /SURF_MESH_L/ + & LSURFMSH(NFMAX) ! T if surface uses a mesh cordinates for its geometry + C !!--- end added variables for python geometry manipulation --- @@ -526,6 +530,7 @@ C !!--- end added variables for python geometry manipulation --- REAL(kind=avl_real) RLE2, CHORD2 REAL(kind=avl_real) WSTRIP REAL(kind=avl_real) TANLE, TANTE + REAL(kind=avl_real) GINCSTRIP REAL(kind=avl_real) CLCD REAL(kind=avl_real) SAXFR REAL(kind=avl_real) ESS @@ -561,6 +566,7 @@ C !!--- end added variables for python geometry manipulation --- & RLE2(3,NSMAX), CHORD2(NSMAX), ! strip right end LE point, chord & WSTRIP(NSMAX), ! strip y-z width & TANLE(NSMAX), TANTE(NSMAX), ! strip LE,TE sweep slopes + & GINCSTRIP(NSMAX), ! strip geometric incidence angle & CLCD(NUMAX,NSMAX), ! strip viscous polar & SAXFR, ! x/c of spanwise axis for Vperp def & ESS(3,NSMAX), ! spanwise unit vector for Vperp def @@ -618,6 +624,7 @@ C REAL(kind=avl_real) RS REAL(kind=avl_real) RL,RADL REAL(kind=avl_real) DXV + REAL(kind=avl_real) DXSTRPV REAL(kind=avl_real) CHORDV REAL(kind=avl_real) SLOPEV REAL(kind=avl_real) SLOPEC @@ -662,6 +669,7 @@ C & RS(3,NVMAX), ! h.v. source points & RL(3,NLMAX),RADL(NLMAX), ! source line node points, body radius & DXV(NVMAX), ! chord of element + & DXSTRPV(NVMAX), ! chord of element projected onto chord of element-containing strip & CHORDV(NVMAX), ! chord of element-containing strip & SLOPEV(NVMAX), ! camber slopes at h.v. bound leg & SLOPEC(NVMAX), ! camber slopes at c.p. diff --git a/src/includes/AVL_ad_seeds.inc b/src/includes/AVL_ad_seeds.inc index 1900531..312a556 100644 --- a/src/includes/AVL_ad_seeds.inc +++ b/src/includes/AVL_ad_seeds.inc @@ -354,6 +354,8 @@ C real(kind=avl_real) XBOD_DIFF real(kind=avl_real) YBOD_DIFF real(kind=avl_real) TBOD_DIFF + real(kind=avl_real) XBOD_R_DIFF + real(kind=avl_real) YBOD_R_DIFF COMMON /BODY_GEOM_R_DIFF/ & XYZSCAL_B_DIFF(3, NBMAX), & XYZTRAN_B_DIFF(3, NBMAX), @@ -362,7 +364,9 @@ C & BSPACE_DIFF(NBMAX), & XBOD_DIFF(IBX, NBMAX), & YBOD_DIFF(IBX, NBMAX), - & TBOD_DIFF(IBX, NBMAX) + & TBOD_DIFF(IBX, NBMAX), + & XBOD_R_DIFF(IBX, NBMAX), + & YBOD_R_DIFF(IBX, NBMAX) C real(kind=avl_real) XYZSCAL_DIFF real(kind=avl_real) XYZTRAN_DIFF @@ -374,8 +378,8 @@ C real(kind=avl_real) XYZLES_DIFF real(kind=avl_real) XSEC_DIFF real(kind=avl_real) YSEC_DIFF - real(kind=avl_real) XFMIN_DIFF - real(kind=avl_real) XFMAX_DIFF + real(kind=avl_real) XFMIN_R_DIFF + real(kind=avl_real) XFMAX_R_DIFF real(kind=avl_real) XLASEC_DIFF real(kind=avl_real) ZLASEC_DIFF real(kind=avl_real) XUASEC_DIFF @@ -405,8 +409,8 @@ C & XYZLES_DIFF(3, NSMAX, NFMAX), & XSEC_DIFF(IBX, NSMAX, NFMAX), & YSEC_DIFF(IBX, NSMAX, NFMAX), - & XFMIN_DIFF(NSMAX, NFMAX), - & XFMAX_DIFF(NSMAX, NFMAX), + & XFMIN_R_DIFF(NSMAX, NFMAX), + & XFMAX_R_DIFF(NSMAX, NFMAX), & XLASEC_DIFF(IBX, NSMAX, NFMAX), & ZLASEC_DIFF(IBX, NSMAX, NFMAX), & XUASEC_DIFF(IBX, NSMAX, NFMAX), @@ -425,6 +429,10 @@ C & GAIND_DIFF(ICONX, NSMAX, NFMAX), & REFLD_DIFF(ICONX, NSMAX, NFMAX), & GAING_DIFF(ICONX, NSMAX, NFMax) +C + real(kind=avl_real) MSHBLK_DIFF + COMMON /SURF_MESH_R_DIFF/ + & MSHBLK_DIFF(3, 4*NVMAX) C real(kind=avl_real) RLE_DIFF real(kind=avl_real) CHORD_DIFF @@ -435,6 +443,7 @@ C real(kind=avl_real) WSTRIP_DIFF real(kind=avl_real) TANLE_DIFF real(kind=avl_real) TANTE_DIFF + real(kind=avl_real) GINCSTRIP_DIFF real(kind=avl_real) CLCD_DIFF real(kind=avl_real) SAXFR_DIFF real(kind=avl_real) ESS_DIFF @@ -505,6 +514,7 @@ C & WSTRIP_DIFF(NSMAX), & TANLE_DIFF(NSMAX), & TANTE_DIFF(NSMAX), + & GINCSTRIP_DIFF(NSMAX), & CLCD_DIFF(NUMAX,NSMAX), & SAXFR_DIFF, & ESS_DIFF(3,NSMAX), @@ -574,6 +584,7 @@ C real(kind=avl_real) RL_DIFF real(kind=avl_real) RADL_DIFF real(kind=avl_real) DXV_DIFF + real(kind=avl_real) DXSTRPV_DIFF real(kind=avl_real) CHORDV_DIFF real(kind=avl_real) SLOPEV_DIFF real(kind=avl_real) SLOPEC_DIFF @@ -619,6 +630,7 @@ C & RL_DIFF(3,NLMAX), & RADL_DIFF(NLMAX), & DXV_DIFF(NVMAX), + & DXSTRPV_DIFF(NVMAX), & CHORDV_DIFF(NVMAX), & SLOPEV_DIFF(NVMAX), & SLOPEC_DIFF(NVMAX), diff --git a/src/sgutil.f b/src/sgutil.f index f3d4947..8ab763f 100644 --- a/src/sgutil.f +++ b/src/sgutil.f @@ -310,7 +310,7 @@ SUBROUTINE CSPACER(NVC,CSPACE,CLAF, XPT,XVR,XSR,XCP) ! PSPACE = 3 : EQUAL SPACING. ! CLAF: CL alfa (needed to determine control point location) ! Outputs: - ! XPT: Array of panel x-locations + ! XPT: Array of panel leading edge x-locations ! XVR: Array of vortex x-locations ! XSR: Array of source x-locations ! XCP: Array of control point x-locations From 4c5e34ba53a4c247c41160f81d6cd128fede711b Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 16 Dec 2025 17:54:02 -0500 Subject: [PATCH 20/49] Implemented mesh flattening --- optvl/optvl_class.py | 14 ++- optvl/utils/check_surface_dict.py | 1 + src/aic.f | 5 + src/amake.f | 166 ++++++++++++++++++++++++------ src/includes/AVL.INC.in | 14 ++- 5 files changed, 165 insertions(+), 35 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 36bc3c5..2b7d0a4 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -823,7 +823,7 @@ def check_type(key, avl_vars, given_val): # Load airfoil data sections # Load the Airfoil Section into AVL for j in range(num_secs): - xfminmax = xfminmax_arr[j] + xfminmax = xfminmax_arr[j] # Manually Specify Coordiantes (no camberline verification, only use if you know what you're doing) if "xasec" in surf_dict.keys(): @@ -944,7 +944,9 @@ def check_type(key, avl_vars, given_val): surf_dict["iptloc"] = np.zeros(surf_dict["num_sections"],dtype=np.int32) self.avl.adjust_mesh_spacing(idx_surf+1,surf_dict["mesh"].transpose((2, 0, 1)),surf_dict["iptloc"]) surf_dict["iptloc"] = surf_dict["iptloc"] - 1 - self.set_mesh(idx_surf, surf_dict["mesh"],surf_dict["iptloc"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering + if "flatten mesh" not in surf_dict.keys(): + surf_dict["flatten mesh"] = True + self.set_mesh(idx_surf, surf_dict["mesh"],surf_dict["iptloc"],flatten=surf_dict["flatten mesh"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering self.avl.makesurf_mesh(idx_surf + 1) #+1 for Fortran indexing else: self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing @@ -1063,7 +1065,7 @@ def check_type(key, avl_vars, given_val): # Tell AVL that geometry exists now and is ready for analysis self.avl.CASE_L.LGEO = True - def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_nvs: bool=False, update_nvc: bool=False): + def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, flatten:bool=True, update_nvs: bool=False, update_nvc: bool=False): """Sets a mesh directly into OptVL. Requires an iptloc vector to define the indices where the sections are defined. This is required for many of AVL's features like control surfaces to work properly. OptVL's input routine has multiple ways of automatically computing this vector. Alternatively, calling the adjust_mesh_spacing subroutine in the Fortran layer @@ -1074,6 +1076,7 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n idx_surf (int): the surface to apply the mesh to mesh (np.ndarray): XYZ mesh array (nx,ny,3) iptloc (np.ndarray): Vector containing the spanwise indicies where each section is defined (num_sections,) + flatten (bool): Should OptVL flatten the mesh when placing vorticies and control points update_nvs (bool): Should OptVL update the number of spanwise elements for the given mesh update_nvc (bool): Should OptVL update the number of chordwise elements for the given mesh """ @@ -1089,6 +1092,11 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, update_n if update_nvc: self.avl.SURF_GEOM_I.NVC[idx_surf] = nx-1 + if flatten: + self.avl.SURF_MESH_L.LMESHFLAT[idx_surf] = True + else: + self.avl.SURF_MESH_L.LMESHFLAT[idx_surf] = False + # Only add +1 for Fortran indexing if we are not explictly telling the routine to use # nspans by passing in all zeros if not (iptloc == 0).all(): diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index 022824a..cc4c1f2 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -109,6 +109,7 @@ def pre_check_input_dict(input_dict: dict): # Geometery: Mesh "mesh", "iptloc", + "flatten_mesh", # Control Surfaces # "dname" # IMPLEMENT THIS "icontd", # control variable index diff --git a/src/aic.f b/src/aic.f index f1453e9..1c8bfae 100644 --- a/src/aic.f +++ b/src/aic.f @@ -119,6 +119,11 @@ SUBROUTINE VVOR(BETM,IYSYM,YSYM,IZSYM,ZSYM,VRCORE, & RV2(1,J),RV2(2,J),RV2(3,J), & BETM,U,V,W,RCORE) C + ! print *, "Influence of", J, "on", I + ! print *, "U:", U + ! print *, "V:", V + ! print *, "W:", W + ! print *, "MARK" IF(IYSYM.NE.0) THEN C... Calculate the influence of the y-IMAGE vortex LBOUND = .TRUE. diff --git a/src/amake.f b/src/amake.f index 2b85949..1d71504 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1039,7 +1039,8 @@ subroutine makesurf_mesh(isurf) ! Set the strip geometry data ! Note these computations assume the mesh is not necessarily planar - ! but will still work correctly for a planar mesh as well + ! ultimately if/when we flatten the mesh into a planar one we will want + ! to use the leading edge positions and chords from the original input mesh ! Loop over strips in section do ispan = 1,nspan @@ -1078,14 +1079,14 @@ subroutine makesurf_mesh(isurf) ! Strip geometric incidence angle at the mid-point ! This is strip incidence angle is computed from the LE and TE points ! of the given geometry and is completely independent of AINC - ! This quantity is needed to correctly handle nonplanar meshes + ! This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isn't flattened GINCSTRIP(idx_strip) = atan2(((mesh_surf(3,idx_node_nx) & + mesh_surf(3,idx_node_nx_yp1))/2.- (mesh_surf(3,idx_node) + & mesh_surf(3,idx_node_yp1))/2.), & ((mesh_surf(1,idx_node_nx) + mesh_surf(1,idx_node_nx_yp1))/2. & - (mesh_surf(1,idx_node) + mesh_surf(1,idx_node_yp1))/2.)) - ! Strip width (leading edge) + ! Strip width m2 = mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_node) m3 = mesh_surf(3,idx_node_yp1)-mesh_surf(3,idx_node) WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) @@ -1268,42 +1269,86 @@ subroutine makesurf_mesh(isurf) do idx_x = 1, nvc(isurf) ! Left bound vortex points - ! Y- point idx_node = flatidx(idx_x,idx_y,isurf) - RV1(2,idx_vor) = mesh_surf(2,idx_node) - ! Compute the panel's left side chord and angle + ! Compute the panel's left side chord dc1 = sqrt((mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))**2 & + (mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node))**2) + + if (LMESHFLAT(isurf)) then + ! Place vortex at panel quarter chord of the flat mesh + dx1 = sqrt((mesh_surf(1,idx_node) - RLE1(1,idx_strip))**2 + & + (mesh_surf(3,idx_node) - RLE1(3,idx_strip))**2) + RV1(2,idx_vor) = RLE1(2,idx_strip) + RV1(3,idx_vor) = RLE1(3,idx_strip) + RV1(1,idx_vor) = RLE1(1,idx_strip) + dx1 + (dc1/4.) + + ! Compute the panel's left side angle + a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), + & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) + ! Place vortex at panel quarter chord + RV1MSH(2,idx_vor) = mesh_surf(2,idx_node) + RV1MSH(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) + RV1MSH(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) + else + ! Compute the panel's left side angle a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) ! Place vortex at panel quarter chord + RV1(2,idx_vor) = mesh_surf(2,idx_node) RV1(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) - RV1(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) + RV1(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) + + ! Copy to Mesh + RV1MSH(2,idx_vor) = RV1(2,idx_vor) + RV1MSH(1,idx_vor) = RV1(1,idx_vor) + RV1MSH(3,idx_vor) = RV1(3,idx_vor) + end if ! Right bound vortex points - ! Y- point idx_node_yp1 = flatidx(idx_x,idx_y+1,isurf) - RV2(2,idx_vor) = mesh_surf(2,idx_node_yp1) - ! Compute the panel's right side chord and angle + ! Compute the panel's right side chord dc2 = sqrt((mesh_surf(1,idx_node_yp1+1) & - mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_yp1+1) & - mesh_surf(3,idx_node_yp1))**2) + + if (LMESHFLAT(isurf)) then + ! Place vortex at panel quarter chord of the flat mesh + dx2 = sqrt((mesh_surf(1,idx_node_yp1) - RLE2(1,idx_strip))**2 + & + (mesh_surf(3,idx_node_yp1) - RLE2(3,idx_strip))**2) + RV2(2,idx_vor) = RLE2(2,idx_strip) + RV2(3,idx_vor) = RLE2(3,idx_strip) + RV2(1,idx_vor) = RLE2(1,idx_strip) + dx2 + (dc2/4.) + ! Compute the panel's right side angle a2 = atan2((mesh_surf(3,idx_node_yp1+1) - & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - & mesh_surf(1,idx_node_yp1))) ! Place vortex at panel quarter chord + RV2MSH(2,idx_vor) = mesh_surf(2,idx_node_yp1) + RV2MSH(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) + RV2MSH(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) + else + ! Compute the panel's right side angle + a2 = atan2((mesh_surf(3,idx_node_yp1+1) - + & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - + & mesh_surf(1,idx_node_yp1))) + ! Place vortex at panel quarter chord + RV2(2,idx_vor) = mesh_surf(2,idx_node_yp1) RV2(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) RV2(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) + ! Copy to Mesh + RV2MSH(2,idx_vor) = RV2(2,idx_vor) + RV2MSH(1,idx_vor) = RV2(1,idx_vor) + RV2MSH(3,idx_vor) = RV2(3,idx_vor) + end if + ! Mid-point bound vortex points - ! Y- point - RV(2,idx_vor) = (mesh_surf(2,idx_node_yp1) - & + mesh_surf(2,idx_node))/2. - ! Compute the panel's mid-point chord and angle + ! Compute the panel's mid-point chord ! Panels themselves can never be curved so just interpolate the chord ! store as the panel chord in common block DXV(idx_vor) = (dc1+dc2)/2. - ! However compute the mid-point angle straight up since Drela never interpolates angles + ! We need to compute the midpoint angle and panel strip chord projection + ! as we need them to compute normals based on the real mesh a3 = atan2(((mesh_surf(3,idx_node_yp1+1) & + mesh_surf(3,idx_node+1))/2.- (mesh_surf(3,idx_node_yp1) + & mesh_surf(3,idx_node))/2.), @@ -1311,12 +1356,39 @@ subroutine makesurf_mesh(isurf) & - (mesh_surf(1,idx_node_yp1) + mesh_surf(1,idx_node))/2.)) ! project the panel chord onto the strip chord DXSTRPV(idx_vor) = DXV(idx_vor)*cos(a3-GINCSTRIP(idx_strip)) + + if (LMESHFLAT(isurf)) then + ! Place vortex at panel quarter chord of the flat mesh + dx3 = sqrt(((mesh_surf(1,idx_node_yp1)+mesh_surf(1,idx_node))/2 + & - RLE(1,idx_strip))**2 + & + ((mesh_surf(3,idx_node_yp1)+mesh_surf(3,idx_node))/2 + & - RLE(3,idx_strip))**2) + RV(2,idx_vor) = RLE(2,idx_strip) + RV(3,idx_vor) = RLE(3,idx_strip) + RV(1,idx_vor) = RLE(1,idx_strip) + dx3 + (DXV(idx_vor)/4.) + + ! Place vortex at panel quarter chord + RVMSH(2,idx_vor) = (mesh_surf(2,idx_node_yp1) + & + mesh_surf(2,idx_node))/2. + RVMSH(1,idx_vor) = (mesh_surf(1,idx_node_yp1) + & +mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) + RVMSH(3,idx_vor) = (mesh_surf(3,idx_node_yp1) + & +mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) + else ! Place vortex at panel quarter chord + RV(2,idx_vor) = (mesh_surf(2,idx_node_yp1) + & + mesh_surf(2,idx_node))/2. RV(1,idx_vor) = (mesh_surf(1,idx_node_yp1) & +mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) RV(3,idx_vor) = (mesh_surf(3,idx_node_yp1) & +mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) + ! Copy to Mesh + RVMSH(2,idx_vor) = RV(2,idx_vor) + RVMSH(1,idx_vor) = RV(1,idx_vor) + RVMSH(3,idx_vor) = RV(3,idx_vor) + end if + ! Panel Control points ! Y- point @@ -1325,17 +1397,37 @@ subroutine makesurf_mesh(isurf) ! Place the control point at the quarter chord + half chord*clafc ! note that clafc is a scaler so is 1. is for 2pi ! use data from vortex mid-point computation + if (LMESHFLAT(isurf)) then + RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.) + RC(3,idx_vor) = RV(3,idx_vor) + + RCMSH(1,idx_vor) = RVMSH(1,idx_vor) + & + clafc*(DXV(idx_vor)/2.)*cos(a3) + RCMSH(3,idx_vor) = RVMSH(3,idx_vor) + & + clafc*(DXV(idx_vor)/2.)*sin(a3) + RCMSH(2,idx_vor) = RVMSH(2,idx_vor) + else RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) + RCMSH(1,idx_vor) = RC(1,idx_vor) + RCMSH(3,idx_vor) = RC(3,idx_vor) + RCMSH(2,idx_vor) = RC(2,idx_vor) + end if + ! Source points ! Y- point RS(2,idx_vor) = RV(2,idx_vor) ! Place the source point at the half chord ! use data from vortex mid-point computation ! add another quarter chord to the quarter chord + if (LMESHFLAT(isurf)) then + RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.) + RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.) + else RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) + end if ! Set the camber slopes for the panel @@ -1404,6 +1496,7 @@ subroutine makesurf_mesh(isurf) ! Store the panel LE mid point for the next panel in the strip ! This gets used a lot here + ! We use the original input mesh to compute point for the OML xptxind1 = ((mesh_surf(1,idx_node+1)+mesh_surf(1,idx_node_yp1+1)) & /2 - RLE(1,idx_strip))/CHORD(idx_strip) @@ -1804,6 +1897,7 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) LFLOAD(NNI) = LFLOAD(NN) LRANGE(NNI) = LRANGE(NN) LSURFSPACING(NNI) = LSURFSPACING(NN) + LMESHFLAT(NNI) = LMESHFLAT(NN) C---- accumulate stuff for new image surface ! IFRST(NNI) = NVOR + 1 @@ -1926,6 +2020,18 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) RC(1,III) = RC(1,II) RC(2,III) = -RC(2,II) + YOFF RC(3,III) = RC(3,II) + RV1MSH(1,III) = RV2MSH(1,II) + RV1MSH(2,III) = -RV2MSH(2,II) + YOFF + RV1MSH(3,III) = RV2MSH(3,II) + RV2MSH(1,III) = RV1MSH(1,II) + RV2MSH(2,III) = -RV1MSH(2,II) + YOFF + RV2MSH(3,III) = RV1MSH(3,II) + RVMSH(1,III) = RVMSH(1,II) + RVMSH(2,III) = -RVMSH(2,II) + YOFF + RVMSH(3,III) = RVMSH(3,II) + RCMSH(1,III) = RCMSH(1,II) + RCMSH(2,III) = -RCMSH(2,II) + YOFF + RCMSH(3,III) = RCMSH(3,II) SLOPEC(III) = SLOPEC(II) SLOPEV(III) = SLOPEV(II) DXV(III) = DXV(II) @@ -2366,12 +2472,12 @@ SUBROUTINE ENCALC2 ! print *, "I", I ! compute the spanwise unit vector for Vperp def - DXT = RV2(1,I)-RV1(1,I) - DYT = RV2(2,I)-RV1(2,I) - DZT = RV2(3,I)-RV1(3,I) - XSREF(J) = RV(1,I) - YSREF(J) = RV(2,I) - ZSREF(J) = RV(3,I) + DXT = RV2MSH(1,I)-RV1MSH(1,I) + DYT = RV2MSH(2,I)-RV1MSH(2,I) + DZT = RV2MSH(3,I)-RV1MSH(3,I) + XSREF(J) = RVMSH(1,I) + YSREF(J) = RVMSH(2,I) + ZSREF(J) = RVMSH(3,I) ! print *, "DVT", DYT ! print *, "RV2(2,I)-RV1(2,I)", RV2(2,I)-RV1(2,I) @@ -2417,9 +2523,9 @@ SUBROUTINE ENCALC2 ENDDO C C...Define unit vector along bound leg - DXB = RV2(1,I)-RV1(1,I) ! right h.v. pt - left h.v. pt - DYB = RV2(2,I)-RV1(2,I) - DZB = RV2(3,I)-RV1(3,I) + DXB = RV2MSH(1,I)-RV1MSH(1,I) ! right h.v. pt - left h.v. pt + DYB = RV2MSH(2,I)-RV1MSH(2,I) + DZB = RV2MSH(3,I)-RV1MSH(3,I) EMAG = SQRT(DXB**2 + DYB**2 + DZB**2) EB(1) = DXB/EMAG EB(2) = DYB/EMAG @@ -2453,9 +2559,9 @@ SUBROUTINE ENCALC2 ! which is ES(2) and ES(3) computed earlier SINC = SIN(ANG) COSC = COS(ANG) - EC(1) = COSC + (RC(1,I)-RV(1,I)) - EC(2) = -SINC*ES(2) + (RC(2,I)-RV(2,I)) - EC(3) = -SINC*ES(3) + (RC(3,I)-RV(3,I)) + EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) + EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) + EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) DO N = 1, NDESIGN EC_G(1,N) = -SINC *AINC_G(J,N) @@ -2504,9 +2610,9 @@ SUBROUTINE ENCALC2 C SINC = SIN(ANG) COSC = COS(ANG) - EC(1) = COSC + (RC(1,I)-RV(1,I)) - EC(2) = -SINC*ES(2) + (RC(2,I)-RV(2,I)) - EC(3) = -SINC*ES(3) + (RC(3,I)-RV(3,I)) + EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) + EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) + EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) DO N = 1, NDESIGN EC_G(1,N) = -SINC *AINC_G(J,N) EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) diff --git a/src/includes/AVL.INC.in b/src/includes/AVL.INC.in index 033c549..e436046 100644 --- a/src/includes/AVL.INC.in +++ b/src/includes/AVL.INC.in @@ -502,12 +502,22 @@ c & IPTSEC(NSMAX,NFMAX) ! stores the iptloc vector for each surface REAL(kind=avl_real) MSHBLK + REAL(kind=avl_real) RV1MSH + REAL(kind=avl_real) RV2MSH + REAL(kind=avl_real) RVMSH + REAL(kind=avl_real) RCMSH COMMON /SURF_MESH_R/ - & MSHBLK(3, 4*NVMAX) ! block to store all surface meshes + & MSHBLK(3, 4*NVMAX), ! block to store all surface meshes + & RV1MSH(3,NVMAX), ! mesh h.v. vortex left points + & RV2MSH(3,NVMAX), ! mesh h.v. vortex right points + & RVMSH(3,NVMAX), ! mesh h.v. vortex center points + & RCMSH(3,NVMAX) ! mesh h.v. control points LOGICAL LSURFMSH + LOGICAL LMESHFLAT COMMON /SURF_MESH_L/ - & LSURFMSH(NFMAX) ! T if surface uses a mesh cordinates for its geometry + & LSURFMSH(NFMAX), ! T if surface uses a mesh cordinates for its geometry + & LMESHFLAT(NFMAX) ! T if the surface's mesh should be flattened when computing vorticies and control points C !!--- end added variables for python geometry manipulation --- From e264a5fed89b175eb16e165e68986912f1c58ff4 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 12 Jan 2026 18:20:27 -0500 Subject: [PATCH 21/49] start cleaning up for PR --- src/amake.f | 63 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 27 deletions(-) diff --git a/src/amake.f b/src/amake.f index 1d71504..604c19e 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1285,7 +1285,7 @@ subroutine makesurf_mesh(isurf) ! Compute the panel's left side angle a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) - ! Place vortex at panel quarter chord + ! Place vortex at panel quarter chord of the true mesh RV1MSH(2,idx_vor) = mesh_surf(2,idx_node) RV1MSH(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) RV1MSH(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) @@ -1298,7 +1298,7 @@ subroutine makesurf_mesh(isurf) RV1(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) RV1(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) - ! Copy to Mesh + ! Make a copy in the true mesh array for post processing RV1MSH(2,idx_vor) = RV1(2,idx_vor) RV1MSH(1,idx_vor) = RV1(1,idx_vor) RV1MSH(3,idx_vor) = RV1(3,idx_vor) @@ -1318,11 +1318,12 @@ subroutine makesurf_mesh(isurf) RV2(2,idx_vor) = RLE2(2,idx_strip) RV2(3,idx_vor) = RLE2(3,idx_strip) RV2(1,idx_vor) = RLE2(1,idx_strip) + dx2 + (dc2/4.) + ! Compute the panel's right side angle a2 = atan2((mesh_surf(3,idx_node_yp1+1) - & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - & mesh_surf(1,idx_node_yp1))) - ! Place vortex at panel quarter chord + ! Place vortex at panel quarter chord of the true mesh RV2MSH(2,idx_vor) = mesh_surf(2,idx_node_yp1) RV2MSH(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) RV2MSH(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) @@ -1336,7 +1337,7 @@ subroutine makesurf_mesh(isurf) RV2(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) RV2(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) - ! Copy to Mesh + ! Make a copy in the true mesh array for post processing RV2MSH(2,idx_vor) = RV2(2,idx_vor) RV2MSH(1,idx_vor) = RV2(1,idx_vor) RV2MSH(3,idx_vor) = RV2(3,idx_vor) @@ -1367,7 +1368,7 @@ subroutine makesurf_mesh(isurf) RV(3,idx_vor) = RLE(3,idx_strip) RV(1,idx_vor) = RLE(1,idx_strip) + dx3 + (DXV(idx_vor)/4.) - ! Place vortex at panel quarter chord + ! Place vortex at panel quarter chord of the true mesh RVMSH(2,idx_vor) = (mesh_surf(2,idx_node_yp1) & + mesh_surf(2,idx_node))/2. RVMSH(1,idx_vor) = (mesh_surf(1,idx_node_yp1) @@ -1383,7 +1384,7 @@ subroutine makesurf_mesh(isurf) RV(3,idx_vor) = (mesh_surf(3,idx_node_yp1) & +mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) - ! Copy to Mesh + ! Make a copy in the true mesh array for post processing RVMSH(2,idx_vor) = RV(2,idx_vor) RVMSH(1,idx_vor) = RV(1,idx_vor) RVMSH(3,idx_vor) = RV(3,idx_vor) @@ -1410,6 +1411,7 @@ subroutine makesurf_mesh(isurf) RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) + ! Make a copy in the true mesh array for post processing RCMSH(1,idx_vor) = RC(1,idx_vor) RCMSH(3,idx_vor) = RC(3,idx_vor) RCMSH(2,idx_vor) = RC(2,idx_vor) @@ -1496,7 +1498,7 @@ subroutine makesurf_mesh(isurf) ! Store the panel LE mid point for the next panel in the strip ! This gets used a lot here - ! We use the original input mesh to compute point for the OML + ! We use the original input mesh (true mesh) to compute points for the OML xptxind1 = ((mesh_surf(1,idx_node+1)+mesh_surf(1,idx_node_yp1+1)) & /2 - RLE(1,idx_strip))/CHORD(idx_strip) @@ -1557,7 +1559,7 @@ subroutine makesurf_mesh(isurf) end do ! End section loop - ! Compute the wetted area + ! Compute the wetted area and cave from the true mesh sum = 0.0 wtot = 0.0 DO JJ = 1, NJ(isurf) @@ -1623,14 +1625,17 @@ subroutine update_surfaces() endif end do - !CALL ENCALC - CALL ENCALC2 + if (lsurfmsh(isurf)) then + CALL ENCALCMSH + else + CALL ENCALC + end if LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them LVEL = .FALSE. ! Tell AVL that the induced velocity matrix is no longer valid and to regenerate it LSOL = .FALSE. ! Tell AVL that a valid solution no longer exists - LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exists + LSEN = .FALSE. ! Tell AVL that valid sensitives no longer exist end subroutine update_surfaces @@ -2020,18 +2025,6 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) RC(1,III) = RC(1,II) RC(2,III) = -RC(2,II) + YOFF RC(3,III) = RC(3,II) - RV1MSH(1,III) = RV2MSH(1,II) - RV1MSH(2,III) = -RV2MSH(2,II) + YOFF - RV1MSH(3,III) = RV2MSH(3,II) - RV2MSH(1,III) = RV1MSH(1,II) - RV2MSH(2,III) = -RV1MSH(2,II) + YOFF - RV2MSH(3,III) = RV1MSH(3,II) - RVMSH(1,III) = RVMSH(1,II) - RVMSH(2,III) = -RVMSH(2,II) + YOFF - RVMSH(3,III) = RVMSH(3,II) - RCMSH(1,III) = RCMSH(1,II) - RCMSH(2,III) = -RCMSH(2,II) + YOFF - RCMSH(3,III) = RCMSH(3,II) SLOPEC(III) = SLOPEC(II) SLOPEV(III) = SLOPEV(II) DXV(III) = DXV(II) @@ -2040,6 +2033,22 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) NSURFV(III) = LSCOMP(NNI) LVALBE(III) = LVALBE(II) LVNC(III) = LVNC(II) + ! Duplicate mesh data if we are using a mesh + if (lsurfmsh(NN)) then + RV1MSH(1,III) = RV2MSH(1,II) + RV1MSH(2,III) = -RV2MSH(2,II) + YOFF + RV1MSH(3,III) = RV2MSH(3,II) + RV2MSH(1,III) = RV1MSH(1,II) + RV2MSH(2,III) = -RV1MSH(2,II) + YOFF + RV2MSH(3,III) = RV1MSH(3,II) + RVMSH(1,III) = RVMSH(1,II) + RVMSH(2,III) = -RVMSH(2,II) + YOFF + RVMSH(3,III) = RVMSH(3,II) + RCMSH(1,III) = RCMSH(1,II) + RCMSH(2,III) = -RCMSH(2,II) + YOFF + RCMSH(3,III) = RCMSH(3,II) + end if + C DO N = 1, NCONTROL ccc RSGN = SIGN( 1.0 , VREFL(JJ,N) ) @@ -2413,11 +2422,11 @@ SUBROUTINE ENCALC - SUBROUTINE ENCALC2 + SUBROUTINE ENCALCMSH C C...PURPOSE To calculate the normal vectors for the strips, C the horseshoe vortices, and the control points. -C Assuming arbitrary point cloud geometry +C Assuming arbitrary point cloud mesh C Incorporates surface deflections. C C...INPUT NVOR Number of vortices @@ -2647,7 +2656,7 @@ SUBROUTINE ENCALC2 C======================================================= C-------- rotate normal vectors for control surface ! this is a pure rotation of the normal vector - ! the mesh geometric contribution is already accounted for + ! the geometric contribution from the mesh is already accounted for DO 100 N = 1, NCONTROL C C---------- skip everything if this element is unaffected by control variable N @@ -2708,4 +2717,4 @@ SUBROUTINE ENCALC2 LENC = .TRUE. C RETURN - END ! ENCALC2 \ No newline at end of file + END ! ENCALCMSH \ No newline at end of file From cc678793f53e7637260b22bf296ecae531349200 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 13 Jan 2026 18:33:14 -0500 Subject: [PATCH 22/49] integrated encalc routine for custom meshes into the main one --- src/amake.f | 678 +++++++++++++++++++++++++++++----------------------- src/aoper.f | 6 +- src/avl.f | 6 +- 3 files changed, 386 insertions(+), 304 deletions(-) diff --git a/src/amake.f b/src/amake.f index 604c19e..00ea9b2 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1625,11 +1625,7 @@ subroutine update_surfaces() endif end do - if (lsurfmsh(isurf)) then - CALL ENCALCMSH - else - CALL ENCALC - end if + CALL ENCALC LAIC = .FALSE. ! Tell AVL that the AIC is no longer valid and to regenerate it LSRD = .FALSE. ! Tell AVL that unit source+doublet strengths are no longer valid and to regenerate them @@ -1769,8 +1765,7 @@ subroutine update_bodies() endif end do - !CALL ENCALC - CALL ENCALC2 + CALL ENCALC LAIC = .FALSE. LSRD = .FALSE. @@ -1903,6 +1898,7 @@ SUBROUTINE SDUPL(NN, Ypt,MSG) LRANGE(NNI) = LRANGE(NN) LSURFSPACING(NNI) = LSURFSPACING(NN) LMESHFLAT(NNI) = LMESHFLAT(NN) + LSURFMSH(NNI) = LSURFMSH(NN) C---- accumulate stuff for new image surface ! IFRST(NNI) = NVOR + 1 @@ -2156,6 +2152,8 @@ SUBROUTINE ENCALC C...PURPOSE To calculate the normal vectors for the strips, C the horseshoe vortices, and the control points. C Incorporates surface deflections. + ! Also checks if surface has been assigned a point cloud mesh + ! and uses the real mesh to compute normals if it is C C...INPUT NVOR Number of vortices C X1 Coordinates of endpoint #1 of the vortices @@ -2179,10 +2177,46 @@ SUBROUTINE ENCALC C REAL EP(3), EQ(3), ES(3), EB(3), EC(3), ECXB(3) REAL EC_G(3,NDMAX), ECXB_G(3) + real(kind=avl_real) :: dchstrip, DXT, DYT, DZT C C...Calculate the normal vector at control points and bound vortex midpoints C DO 10 J = 1, NSTRIP + + ! Since we cannot seperate the encalc routine for direct mesh assignment we have to make it a branch here + if (lsurfmsh(nsurfs(J))) then + + ! Calculate normal vector for the strip (normal to X axis) + ! we can't just interpolate this anymore given that + ! the strip is no longer necessarily linear chordwise + + ! We want the spanwise unit vector for the strip at the + ! chordwise location specified by SAXFR (usually set to 0.25) + ! Loop over all panels in the strip until we find the one that contains + ! the SAXFR position in it's projected chord. Since the panels themselves are still linear + ! we can just use the bound vortex unit vector of that panel as + ! the spanwise unit vector of the strip at SAXFR + + ! SAB: This is slow, find a better way to do this + dchstrip = 0.0 + searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) + dchstrip = dchstrip+DXSTRPV(i) + if (dchstrip .ge. CHORD(J)*SAXFR) then + exit searchSAXFR + end if + end do searchSAXFR + + + ! compute the spanwise unit vector for Vperp def + DXT = RV2MSH(1,I)-RV1MSH(1,I) + DYT = RV2MSH(2,I)-RV1MSH(2,I) + DZT = RV2MSH(3,I)-RV1MSH(3,I) + XSREF(J) = RVMSH(1,I) + YSREF(J) = RVMSH(2,I) + ZSREF(J) = RVMSH(3,I) + + else + ! original encalc routine for standard AVL geometry C C...Calculate normal vector for the strip (normal to X axis) I = IJFRST(J) @@ -2210,290 +2244,13 @@ SUBROUTINE ENCALC DXT = (1.0-SAXFR)*DXLE + SAXFR*DXTE DYT = (1.0-SAXFR)*DYLE + SAXFR*DYTE DZT = (1.0-SAXFR)*DZLE + SAXFR*DZTE -C - ESS(1,J) = DXT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) - ESS(2,J) = DYT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) - ESS(3,J) = DZT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) -C - ENSY(J) = -DZT/SQRT(DYT*DYT + DZT*DZT) - ENSZ(J) = DYT/SQRT(DYT*DYT + DZT*DZT) C XSREF(J) = (1.0-SAXFR)*AXLE + SAXFR*AXTE YSREF(J) = (1.0-SAXFR)*AYLE + SAXFR*AYTE ZSREF(J) = (1.0-SAXFR)*AZLE + SAXFR*AZTE + end if C C - ES(1) = 0. - ES(2) = ENSY(J) - ES(3) = ENSZ(J) -C - LSTRIPOFF(J) = .FALSE. -C - NV = NVSTRP(J) - DO 105 II = 1, NV -C - I = IJFRST(J) + (II-1) -C - DO N = 1, NCONTROL - ENV_D(1,I,N) = 0. - ENV_D(2,I,N) = 0. - ENV_D(3,I,N) = 0. - ENC_D(1,I,N) = 0. - ENC_D(2,I,N) = 0. - ENC_D(3,I,N) = 0. - ENDDO -C - DO N = 1, NDESIGN - ENV_G(1,I,N) = 0. - ENV_G(2,I,N) = 0. - ENV_G(3,I,N) = 0. - ENC_G(1,I,N) = 0. - ENC_G(2,I,N) = 0. - ENC_G(3,I,N) = 0. - ENDDO -C -C...Define unit vector along bound leg - DXB = RV2(1,I)-RV1(1,I) ! right h.v. pt - left h.v. pt - DYB = RV2(2,I)-RV1(2,I) - DZB = RV2(3,I)-RV1(3,I) - EMAG = SQRT(DXB**2 + DYB**2 + DZB**2) - EB(1) = DXB/EMAG - EB(2) = DYB/EMAG - EB(3) = DZB/EMAG -C -C...Define direction of normal vector at control point -C The YZ projection of the normal vector matches the camber slope -C + section local incidence in the YZ defining plane for the section - ANG = AINC(J) - ATAN(SLOPEC(I)) -cc IF(LDES) THEN -C--------- add design-variable contribution to angle - DO N = 1, NDESIGN - ANG = ANG + AINC_G(J,N)*DELDES(N) - ENDDO -cc ENDIF -C - SINC = SIN(ANG) - COSC = COS(ANG) - EC(1) = COSC - EC(2) = -SINC*ES(2) - EC(3) = -SINC*ES(3) - ! EC = rotation of strip normal vector? or along chord? - DO N = 1, NDESIGN - EC_G(1,N) = -SINC *AINC_G(J,N) - EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) - EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) - ENDDO -C -C...Normal vector is perpendicular to camberline vector and to the bound leg - CALL CROSS(EC,EB,ECXB) - EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) - IF(EMAG.NE.0.0) THEN - ENC(1,I) = ECXB(1)/EMAG - ENC(2,I) = ECXB(2)/EMAG - ENC(3,I) = ECXB(3)/EMAG - DO N = 1, NDESIGN - CALL CROSS(EC_G(1,N),EB,ECXB_G) - EMAG_G = ENC(1,I)*ECXB_G(1) - & + ENC(2,I)*ECXB_G(2) - & + ENC(3,I)*ECXB_G(3) - ENC_G(1,I,N) = (ECXB_G(1) - ENC(1,I)*EMAG_G)/EMAG - ENC_G(2,I,N) = (ECXB_G(2) - ENC(2,I)*EMAG_G)/EMAG - ENC_G(3,I,N) = (ECXB_G(3) - ENC(3,I)*EMAG_G)/EMAG - ENDDO - ELSE - ENC(1,I) = ES(1) - ENC(2,I) = ES(2) - ENC(3,I) = ES(3) - ENDIF -C -C -C...Define direction of normal vector at vortex mid-point. -C The YZ projection of the normal vector matches the camber slope -C + section local incidence in the YZ defining plane for the section - ANG = AINC(J) - ATAN(SLOPEV(I)) -cc IF(LDES) THEN -C--------- add design-variable contribution to angle - DO N = 1, NDESIGN - ANG = ANG + AINC_G(J,N)*DELDES(N) - ENDDO -cc ENDIF -C - SINC = SIN(ANG) - COSC = COS(ANG) - EC(1) = COSC - EC(2) = -SINC*ES(2) - EC(3) = -SINC*ES(3) - DO N = 1, NDESIGN - EC_G(1,N) = -SINC *AINC_G(J,N) - EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) - EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) - ENDDO -C -C...Normal vector is perpendicular to camberline vector and to the bound leg - CALL CROSS(EC,EB,ECXB) - EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) - IF(EMAG.NE.0.0) THEN - ENV(1,I) = ECXB(1)/EMAG - ENV(2,I) = ECXB(2)/EMAG - ENV(3,I) = ECXB(3)/EMAG - DO N = 1, NDESIGN - CALL CROSS(EC_G(1,N),EB,ECXB_G) - EMAG_G = ENC(1,I)*ECXB_G(1) - & + ENC(2,I)*ECXB_G(2) - & + ENC(3,I)*ECXB_G(3) - ENV_G(1,I,N) = (ECXB_G(1) - ENV(1,I)*EMAG_G)/EMAG - ENV_G(2,I,N) = (ECXB_G(2) - ENV(2,I)*EMAG_G)/EMAG - ENV_G(3,I,N) = (ECXB_G(3) - ENV(3,I)*EMAG_G)/EMAG - ENDDO - ELSE - ENV(1,I) = ES(1) - ENV(2,I) = ES(2) - ENV(3,I) = ES(3) - ENDIF -C -C -ccc write(*,*) i, dcontrol(i,1), dcontrol(i,2) -C -C======================================================= -C-------- rotate normal vectors for control surface - DO 100 N = 1, NCONTROL -C -C---------- skip everything if this element is unaffected by control variable N - IF(DCONTROL(I,N).EQ.0.0) GO TO 100 -C - ANG = DTR*DCONTROL(I,N)*DELCON(N) - ANG_DDC = DTR*DCONTROL(I,N) -C - COSD = COS(ANG) - SIND = SIN(ANG) -C -C---------- EP = normal-vector component perpendicular to hinge line - ENDOT = DOT(ENC(1,I),VHINGE(1,J,N)) - EP(1) = ENC(1,I) - ENDOT*VHINGE(1,J,N) - EP(2) = ENC(2,I) - ENDOT*VHINGE(2,J,N) - EP(3) = ENC(3,I) - ENDOT*VHINGE(3,J,N) -C---------- EQ = unit vector perpendicular to both EP and hinge line - CALL CROSS(VHINGE(1,J,N),EP,EQ) -C -C---------- rotated vector would consist of sin,cos parts from EP and EQ, -C- with hinge-parallel component ENDOT restored -cc ENC(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) -cc ENC(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) -cc ENC(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) -C -C---------- linearize about zero deflection (COSD=1, SIND=0) - ENC_D(1,I,N) = ENC_D(1,I,N) + EQ(1)*ANG_DDC - ENC_D(2,I,N) = ENC_D(2,I,N) + EQ(2)*ANG_DDC - ENC_D(3,I,N) = ENC_D(3,I,N) + EQ(3)*ANG_DDC -C -C -C---------- repeat for ENV vector -C -C---------- EP = normal-vector component perpendicular to hinge line - ENDOT = DOT(ENV(1,I),VHINGE(1,J,N)) - EP(1) = ENV(1,I) - ENDOT*VHINGE(1,J,N) - EP(2) = ENV(2,I) - ENDOT*VHINGE(2,J,N) - EP(3) = ENV(3,I) - ENDOT*VHINGE(3,J,N) -C---------- EQ = unit vector perpendicular to both EP and hinge line - CALL CROSS(VHINGE(1,J,N),EP,EQ) -C -C---------- rotated vector would consist of sin,cos parts from EP and EQ, -C- with hinge-parallel component ENDOT restored -cc ENV(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) -cc ENV(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) -cc ENV(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) -C -C---------- linearize about zero deflection (COSD=1, SIND=0) - ENV_D(1,I,N) = ENV_D(1,I,N) + EQ(1)*ANG_DDC - ENV_D(2,I,N) = ENV_D(2,I,N) + EQ(2)*ANG_DDC - ENV_D(3,I,N) = ENV_D(3,I,N) + EQ(3)*ANG_DDC - 100 CONTINUE - 101 CONTINUE -C - 105 CONTINUE - 10 CONTINUE -C - LENC = .TRUE. -C - RETURN - END ! ENCALC - - - - - - SUBROUTINE ENCALCMSH -C -C...PURPOSE To calculate the normal vectors for the strips, -C the horseshoe vortices, and the control points. -C Assuming arbitrary point cloud mesh -C Incorporates surface deflections. -C -C...INPUT NVOR Number of vortices -C X1 Coordinates of endpoint #1 of the vortices -C X2 Coordinates of endpoint #2 of the vortices -C SLOPEV Slope at bound vortices -C SLOPEC Slope at control points -C NSTRIP Number of strips -C IJFRST Index of first element in strip -C NVSTRP No. of vortices in strip -C AINC Angle of incidence of strip -C LDES include design-variable deflections if TRUE -C -C...OUTPUT ENC(3) Normal vector at control point -C ENV(3) Normal vector at bound vortices -C ENSY, ENSZ Strip normal vector (ENSX=0) -C LSTRIPOFF Non-used strip (T) (below z=ZSYM) -C -C...COMMENTS -C - INCLUDE 'AVL.INC' -C - REAL EP(3), EQ(3), ES(3), EB(3), EC(3), ECXB(3) - REAL EC_G(3,NDMAX), ECXB_G(3) - - real(kind=avl_real) :: dchstrip, DXT, DYT, DZT -C -C...Calculate the normal vector at control points and bound vortex midpoints -C - DO 10 J = 1, NSTRIP -C -C...Calculate normal vector for the strip (normal to X axis) - ! we can't just interpolate this anymore given that - ! the strip is no longer necessarily linear chordwise - - ! We want the spanwise unit vector for the strip at the - ! chordwise location specified by SAXFR (usually set to 0.25) - ! Loop over all panels in the strip until we find the one that contains - ! the SAXFR position in it's projected chord. Since the panels themselves are still linear - ! we can just use the bound vortex unit vector of that panel as - ! the spanwise unit vector of the strip at SAXFR - - ! SAB: This is slow, find a better way to do this - dchstrip = 0.0 - searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) - dchstrip = dchstrip+DXSTRPV(i) - if (dchstrip .ge. CHORD(J)*SAXFR) then - exit searchSAXFR - end if - end do searchSAXFR - - ! print *, "I", I - - ! compute the spanwise unit vector for Vperp def - DXT = RV2MSH(1,I)-RV1MSH(1,I) - DYT = RV2MSH(2,I)-RV1MSH(2,I) - DZT = RV2MSH(3,I)-RV1MSH(3,I) - XSREF(J) = RVMSH(1,I) - YSREF(J) = RVMSH(2,I) - ZSREF(J) = RVMSH(3,I) - - ! print *, "DVT", DYT - ! print *, "RV2(2,I)-RV1(2,I)", RV2(2,I)-RV1(2,I) - ! print *, "RV2(2,I)", RV2(2,I) - ! print *, "RV1(2,I)", RV1(2,I) - ! print *, "NSTRIP", NSTRIP - ! print *, "J", J ESS(1,J) = DXT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) ESS(2,J) = DYT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) ESS(3,J) = DZT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) @@ -2530,48 +2287,68 @@ SUBROUTINE ENCALCMSH ENC_G(2,I,N) = 0. ENC_G(3,I,N) = 0. ENDDO -C -C...Define unit vector along bound leg + + if (lsurfmsh(nsurfs(J))) then + ! Define unit vector along bound leg DXB = RV2MSH(1,I)-RV1MSH(1,I) ! right h.v. pt - left h.v. pt DYB = RV2MSH(2,I)-RV1MSH(2,I) DZB = RV2MSH(3,I)-RV1MSH(3,I) + else +C +C...Define unit vector along bound leg + DXB = RV2(1,I)-RV1(1,I) ! right h.v. pt - left h.v. pt + DYB = RV2(2,I)-RV1(2,I) + DZB = RV2(3,I)-RV1(3,I) + end if EMAG = SQRT(DXB**2 + DYB**2 + DZB**2) EB(1) = DXB/EMAG EB(2) = DYB/EMAG EB(3) = DZB/EMAG C C...Define direction of normal vector at control point - +C The YZ projection of the normal vector matches the camber slope +C + section local incidence in the YZ defining plane for the section ! First start by combining the contributions to the panel ! incidence from AVL incidence and camberline slope variables ! these are not actual geometric transformations of the mesh ! but rather further modifications to the chordwise vector that ! will get used to compute normals ANG = AINC(J) - ATAN(SLOPEC(I)) +cc IF(LDES) THEN C--------- add design-variable contribution to angle DO N = 1, NDESIGN ANG = ANG + AINC_G(J,N)*DELDES(N) ENDDO +cc ENDIF C + SINC = SIN(ANG) + COSC = COS(ANG) + + if (lsurfmsh(nsurfs(J))) then + ! direct mesh assignemnt branch ! now we compute the chordwise panel vector ! note that panel's chordwise vector has contributions ! from both the geometry itself and the incidence modification ! from the AVL AINC and camber slope variables ! To avoid storing uncessary info in the common block - ! Get the geometric chordwise vector using RV and RC which should + ! Get the geometric chordwise vector using RVMSH and RCMSH which should ! be located in the same plane given that each individual panel is a ! plane ! Note that like in AVL the sin of the incidence is projected ! to the strip's normal in the YZ plane (Treffz plane) ! which is ES(2) and ES(3) computed earlier - SINC = SIN(ANG) - COSC = COS(ANG) EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) + else + EC(1) = COSC + EC(2) = -SINC*ES(2) + EC(3) = -SINC*ES(3) + ! EC = rotation of strip normal vector? or along chord? + end if DO N = 1, NDESIGN EC_G(1,N) = -SINC *AINC_G(J,N) EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) @@ -2599,29 +2376,37 @@ SUBROUTINE ENCALCMSH ENC(2,I) = ES(2) ENC(3,I) = ES(3) ENDIF - C C C...Define direction of normal vector at vortex mid-point. - +C The YZ projection of the normal vector matches the camber slope +C + section local incidence in the YZ defining plane for the section ! This section is identical to the normal vector at the control ! point. The only different is that the AVL camberline slope ! is taken at the bound vortex point rather than the control point ! the geometric contributions to the normal vector at both of these ! point is identical as the lie in the plane of the same panel. ANG = AINC(J) - ATAN(SLOPEV(I)) - +cc IF(LDES) THEN C--------- add design-variable contribution to angle DO N = 1, NDESIGN ANG = ANG + AINC_G(J,N)*DELDES(N) ENDDO - +cc ENDIF C SINC = SIN(ANG) COSC = COS(ANG) + if (lsurfmsh(nsurfs(J))) then + ! direct mesh assignment branch EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) + else + EC(1) = COSC + EC(2) = -SINC*ES(2) + EC(3) = -SINC*ES(3) + end if + DO N = 1, NDESIGN EC_G(1,N) = -SINC *AINC_G(J,N) EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) @@ -2717,4 +2502,305 @@ SUBROUTINE ENCALCMSH LENC = .TRUE. C RETURN - END ! ENCALCMSH \ No newline at end of file + END ! ENCALC + + + + + +! SUBROUTINE ENCALCMSH +! C +! C...PURPOSE To calculate the normal vectors for the strips, +! C the horseshoe vortices, and the control points. +! C Assuming arbitrary point cloud mesh +! C Incorporates surface deflections. +! C +! C...INPUT NVOR Number of vortices +! C X1 Coordinates of endpoint #1 of the vortices +! C X2 Coordinates of endpoint #2 of the vortices +! C SLOPEV Slope at bound vortices +! C SLOPEC Slope at control points +! C NSTRIP Number of strips +! C IJFRST Index of first element in strip +! C NVSTRP No. of vortices in strip +! C AINC Angle of incidence of strip +! C LDES include design-variable deflections if TRUE +! C +! C...OUTPUT ENC(3) Normal vector at control point +! C ENV(3) Normal vector at bound vortices +! C ENSY, ENSZ Strip normal vector (ENSX=0) +! C LSTRIPOFF Non-used strip (T) (below z=ZSYM) +! C +! C...COMMENTS +! C +! INCLUDE 'AVL.INC' +! C +! REAL EP(3), EQ(3), ES(3), EB(3), EC(3), ECXB(3) +! REAL EC_G(3,NDMAX), ECXB_G(3) + +! real(kind=avl_real) :: dchstrip, DXT, DYT, DZT +! C +! C...Calculate the normal vector at control points and bound vortex midpoints +! C +! DO 10 J = 1, NSTRIP +! C +! C...Calculate normal vector for the strip (normal to X axis) +! ! we can't just interpolate this anymore given that +! ! the strip is no longer necessarily linear chordwise + +! ! We want the spanwise unit vector for the strip at the +! ! chordwise location specified by SAXFR (usually set to 0.25) +! ! Loop over all panels in the strip until we find the one that contains +! ! the SAXFR position in it's projected chord. Since the panels themselves are still linear +! ! we can just use the bound vortex unit vector of that panel as +! ! the spanwise unit vector of the strip at SAXFR + +! ! SAB: This is slow, find a better way to do this +! dchstrip = 0.0 +! searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) +! dchstrip = dchstrip+DXSTRPV(i) +! if (dchstrip .ge. CHORD(J)*SAXFR) then +! exit searchSAXFR +! end if +! end do searchSAXFR + +! ! print *, "I", I + +! ! compute the spanwise unit vector for Vperp def +! DXT = RV2MSH(1,I)-RV1MSH(1,I) +! DYT = RV2MSH(2,I)-RV1MSH(2,I) +! DZT = RV2MSH(3,I)-RV1MSH(3,I) +! XSREF(J) = RVMSH(1,I) +! YSREF(J) = RVMSH(2,I) +! ZSREF(J) = RVMSH(3,I) + +! ! print *, "DVT", DYT +! ! print *, "RV2(2,I)-RV1(2,I)", RV2(2,I)-RV1(2,I) +! ! print *, "RV2(2,I)", RV2(2,I) +! ! print *, "RV1(2,I)", RV1(2,I) +! ! print *, "NSTRIP", NSTRIP +! ! print *, "J", J +! ESS(1,J) = DXT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) +! ESS(2,J) = DYT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) +! ESS(3,J) = DZT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) + +! ! Treffz plane normals +! ENSY(J) = -DZT/SQRT(DYT*DYT + DZT*DZT) +! ENSZ(J) = DYT/SQRT(DYT*DYT + DZT*DZT) + +! ES(1) = 0. +! ES(2) = ENSY(J) +! ES(3) = ENSZ(J) +! C +! LSTRIPOFF(J) = .FALSE. +! C +! NV = NVSTRP(J) +! DO 105 II = 1, NV +! C +! I = IJFRST(J) + (II-1) +! C +! DO N = 1, NCONTROL +! ENV_D(1,I,N) = 0. +! ENV_D(2,I,N) = 0. +! ENV_D(3,I,N) = 0. +! ENC_D(1,I,N) = 0. +! ENC_D(2,I,N) = 0. +! ENC_D(3,I,N) = 0. +! ENDDO +! C +! DO N = 1, NDESIGN +! ENV_G(1,I,N) = 0. +! ENV_G(2,I,N) = 0. +! ENV_G(3,I,N) = 0. +! ENC_G(1,I,N) = 0. +! ENC_G(2,I,N) = 0. +! ENC_G(3,I,N) = 0. +! ENDDO +! C +! C...Define unit vector along bound leg +! DXB = RV2MSH(1,I)-RV1MSH(1,I) ! right h.v. pt - left h.v. pt +! DYB = RV2MSH(2,I)-RV1MSH(2,I) +! DZB = RV2MSH(3,I)-RV1MSH(3,I) +! EMAG = SQRT(DXB**2 + DYB**2 + DZB**2) +! EB(1) = DXB/EMAG +! EB(2) = DYB/EMAG +! EB(3) = DZB/EMAG +! C +! C...Define direction of normal vector at control point + +! ! First start by combining the contributions to the panel +! ! incidence from AVL incidence and camberline slope variables +! ! these are not actual geometric transformations of the mesh +! ! but rather further modifications to the chordwise vector that +! ! will get used to compute normals +! ANG = AINC(J) - ATAN(SLOPEC(I)) +! C--------- add design-variable contribution to angle +! DO N = 1, NDESIGN +! ANG = ANG + AINC_G(J,N)*DELDES(N) +! ENDDO +! C +! ! now we compute the chordwise panel vector +! ! note that panel's chordwise vector has contributions +! ! from both the geometry itself and the incidence modification +! ! from the AVL AINC and camber slope variables + +! ! To avoid storing uncessary info in the common block +! ! Get the geometric chordwise vector using RV and RC which should +! ! be located in the same plane given that each individual panel is a +! ! plane + +! ! Note that like in AVL the sin of the incidence is projected +! ! to the strip's normal in the YZ plane (Treffz plane) +! ! which is ES(2) and ES(3) computed earlier +! SINC = SIN(ANG) +! COSC = COS(ANG) +! EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) +! EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) +! EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) + +! DO N = 1, NDESIGN +! EC_G(1,N) = -SINC *AINC_G(J,N) +! EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) +! EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) +! ENDDO +! C +! C...Normal vector is perpendicular to camberline vector and to the bound leg +! CALL CROSS(EC,EB,ECXB) +! EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) +! IF(EMAG.NE.0.0) THEN +! ENC(1,I) = ECXB(1)/EMAG +! ENC(2,I) = ECXB(2)/EMAG +! ENC(3,I) = ECXB(3)/EMAG +! DO N = 1, NDESIGN +! CALL CROSS(EC_G(1,N),EB,ECXB_G) +! EMAG_G = ENC(1,I)*ECXB_G(1) +! & + ENC(2,I)*ECXB_G(2) +! & + ENC(3,I)*ECXB_G(3) +! ENC_G(1,I,N) = (ECXB_G(1) - ENC(1,I)*EMAG_G)/EMAG +! ENC_G(2,I,N) = (ECXB_G(2) - ENC(2,I)*EMAG_G)/EMAG +! ENC_G(3,I,N) = (ECXB_G(3) - ENC(3,I)*EMAG_G)/EMAG +! ENDDO +! ELSE +! ENC(1,I) = ES(1) +! ENC(2,I) = ES(2) +! ENC(3,I) = ES(3) +! ENDIF + +! C +! C +! C...Define direction of normal vector at vortex mid-point. + +! ! This section is identical to the normal vector at the control +! ! point. The only different is that the AVL camberline slope +! ! is taken at the bound vortex point rather than the control point +! ! the geometric contributions to the normal vector at both of these +! ! point is identical as the lie in the plane of the same panel. +! ANG = AINC(J) - ATAN(SLOPEV(I)) + +! C--------- add design-variable contribution to angle +! DO N = 1, NDESIGN +! ANG = ANG + AINC_G(J,N)*DELDES(N) +! ENDDO + +! C +! SINC = SIN(ANG) +! COSC = COS(ANG) +! EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) +! EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) +! EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) +! DO N = 1, NDESIGN +! EC_G(1,N) = -SINC *AINC_G(J,N) +! EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) +! EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) +! ENDDO +! C +! C...Normal vector is perpendicular to camberline vector and to the bound leg +! CALL CROSS(EC,EB,ECXB) +! EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) +! IF(EMAG.NE.0.0) THEN +! ENV(1,I) = ECXB(1)/EMAG +! ENV(2,I) = ECXB(2)/EMAG +! ENV(3,I) = ECXB(3)/EMAG +! DO N = 1, NDESIGN +! CALL CROSS(EC_G(1,N),EB,ECXB_G) +! EMAG_G = ENC(1,I)*ECXB_G(1) +! & + ENC(2,I)*ECXB_G(2) +! & + ENC(3,I)*ECXB_G(3) +! ENV_G(1,I,N) = (ECXB_G(1) - ENV(1,I)*EMAG_G)/EMAG +! ENV_G(2,I,N) = (ECXB_G(2) - ENV(2,I)*EMAG_G)/EMAG +! ENV_G(3,I,N) = (ECXB_G(3) - ENV(3,I)*EMAG_G)/EMAG +! ENDDO +! ELSE +! ENV(1,I) = ES(1) +! ENV(2,I) = ES(2) +! ENV(3,I) = ES(3) +! ENDIF +! C +! C +! ccc write(*,*) i, dcontrol(i,1), dcontrol(i,2) +! C +! C======================================================= +! C-------- rotate normal vectors for control surface +! ! this is a pure rotation of the normal vector +! ! the geometric contribution from the mesh is already accounted for +! DO 100 N = 1, NCONTROL +! C +! C---------- skip everything if this element is unaffected by control variable N +! IF(DCONTROL(I,N).EQ.0.0) GO TO 100 +! C +! ANG = DTR*DCONTROL(I,N)*DELCON(N) +! ANG_DDC = DTR*DCONTROL(I,N) +! C +! COSD = COS(ANG) +! SIND = SIN(ANG) +! C +! C---------- EP = normal-vector component perpendicular to hinge line +! ENDOT = DOT(ENC(1,I),VHINGE(1,J,N)) +! EP(1) = ENC(1,I) - ENDOT*VHINGE(1,J,N) +! EP(2) = ENC(2,I) - ENDOT*VHINGE(2,J,N) +! EP(3) = ENC(3,I) - ENDOT*VHINGE(3,J,N) +! C---------- EQ = unit vector perpendicular to both EP and hinge line +! CALL CROSS(VHINGE(1,J,N),EP,EQ) +! C +! C---------- rotated vector would consist of sin,cos parts from EP and EQ, +! C- with hinge-parallel component ENDOT restored +! cc ENC(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) +! cc ENC(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) +! cc ENC(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) +! C +! C---------- linearize about zero deflection (COSD=1, SIND=0) +! ENC_D(1,I,N) = ENC_D(1,I,N) + EQ(1)*ANG_DDC +! ENC_D(2,I,N) = ENC_D(2,I,N) + EQ(2)*ANG_DDC +! ENC_D(3,I,N) = ENC_D(3,I,N) + EQ(3)*ANG_DDC +! C +! C +! C---------- repeat for ENV vector +! C +! C---------- EP = normal-vector component perpendicular to hinge line +! ENDOT = DOT(ENV(1,I),VHINGE(1,J,N)) +! EP(1) = ENV(1,I) - ENDOT*VHINGE(1,J,N) +! EP(2) = ENV(2,I) - ENDOT*VHINGE(2,J,N) +! EP(3) = ENV(3,I) - ENDOT*VHINGE(3,J,N) +! C---------- EQ = unit vector perpendicular to both EP and hinge line +! CALL CROSS(VHINGE(1,J,N),EP,EQ) +! C +! C---------- rotated vector would consist of sin,cos parts from EP and EQ, +! C- with hinge-parallel component ENDOT restored +! cc ENV(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) +! cc ENV(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) +! cc ENV(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) +! C +! C---------- linearize about zero deflection (COSD=1, SIND=0) +! ENV_D(1,I,N) = ENV_D(1,I,N) + EQ(1)*ANG_DDC +! ENV_D(2,I,N) = ENV_D(2,I,N) + EQ(2)*ANG_DDC +! ENV_D(3,I,N) = ENV_D(3,I,N) + EQ(3)*ANG_DDC +! 100 CONTINUE +! 101 CONTINUE +! C +! 105 CONTINUE +! 10 CONTINUE +! C +! LENC = .TRUE. +! C +! RETURN +! END ! ENCALCMSH \ No newline at end of file diff --git a/src/aoper.f b/src/aoper.f index c039e82..b65f03b 100644 --- a/src/aoper.f +++ b/src/aoper.f @@ -1618,8 +1618,7 @@ SUBROUTINE OPTGET ENDIF C SAXFR = MAX( 0.0 , MIN(1.0,RINPUT(1)) ) - ! CALL ENCALC - CALL ENCALC2 + CALL ENCALC CALL AERO C C--------------------------------- @@ -1636,8 +1635,7 @@ SUBROUTINE OPTGET ENDIF C VRCORE = MAX( 0.0 , MIN(1.0,RINPUT(1)) ) - ! CALL ENCALC - CALL ENCALC2 + CALL ENCALC LAIC = .FALSE. LSRD = .FALSE. LSOL = .FALSE. diff --git a/src/avl.f b/src/avl.f index 8e42153..0d2b8ca 100644 --- a/src/avl.f +++ b/src/avl.f @@ -96,8 +96,7 @@ SUBROUTINE AVL C----- process geometry to define strip and vortex data LPLTNEW = .TRUE. ! TODO remove? - ! CALL ENCALC - CALL ENCALC2 + CALL ENCALC C C----- initialize state CALL VARINI @@ -456,8 +455,7 @@ SUBROUTINE loadGEO(geom_file) C C----- process geometry to define strip and vortex data LPLTNEW = .TRUE. - ! CALL ENCALC - CALL ENCALC2 + CALL ENCALC C C----- initialize state C CALL VARINI From 426e43f7d8ecc4b318cd2d9776533415f490620e Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Thu, 15 Jan 2026 19:58:37 -0500 Subject: [PATCH 23/49] Added plotting features --- optvl/optvl_class.py | 306 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 306 insertions(+) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 2b7d0a4..02a765d 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -687,6 +687,10 @@ def check_type(key, avl_vars, given_val): # We will insert entries into it for duplicate surfaces later but right now it's only for unique surfaces self.mesh_idx_first = np.zeros(self.get_num_surfaces(),dtype=np.int32) + # Class variable to store the yoffset for duplicated meshes. This information is needed for correcting retreiving + # a duplicated mesh + self.y_offsets = np.zeros(self.get_num_surfaces(),dtype=np.float64) + # Load surfaces if num_surfs > 0: surf_names = list(input_dict["surfaces"].keys()) @@ -955,6 +959,7 @@ def check_type(key, avl_vars, given_val): self.avl.sdupl(idx_surf + 1, surf_dict["yduplicate"], "YDUP") # Insert duplicate into the mesh first index array self.mesh_idx_first = np.insert(self.mesh_idx_first,idx_surf+1,self.mesh_idx_first[idx_surf]) + self.y_offsets[idx_surf] = surf_dict["yduplicate"] self.avl.CASE_I.NSURF += 1 idx_surf += 1 @@ -1120,6 +1125,79 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, flatten: # Flag surface as using mesh geometry self.avl.SURF_MESH_L.LSURFMSH[idx_surf] = True + def get_mesh(self, idx_surf: int, get_full_mesh: bool = False, get_iptloc: bool = False): + """ + + Args: + idx_surf (int): the surface to get the mesh for + get_full_mesh (bool): concatenates and returns the meshes for idx_surf and idx_surf + 1, for use with duplicated surfaces + get_iptloc (bool) : should the iptloc vector for the surface be returned + """ + + # Check if surface is using mesh geometry + if not self.avl.SURF_MESH_L.LSURFMSH[idx_surf]: + raise RuntimeError(f"Surface {idx_surf} does not have a mesh assigned!") + + # Get the mesh size + nx = self.avl.SURF_GEOM_I.NVC[idx_surf] + 1 + ny = self.avl.SURF_GEOM_I.NVS[idx_surf] + 1 + + + # Get the mesh + mesh = self.get_avl_fort_arr("SURF_MESH_R","MSHBLK",slicer=(slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+nx*ny),slice(0,3))) + mesh = copy.deepcopy(mesh.reshape((ny,nx,3)).transpose((1,0,2))) + # mesh = mesh.transpose((1,0,2)) + + # Check if duplicated + imags = self.get_avl_fort_arr("SURF_I", "IMAGS") + if imags[idx_surf] < 0: + mesh[:,:,1] = -mesh[:,:,1] + self.y_offsets[idx_surf-1] + + # Concatenate with duplicate + if get_full_mesh: + if imags[idx_surf] < 0: + raise RuntimeError(f"Concatenating a duplicated surface, {idx_surf}, with the next surface!") + elif imags[idx_surf+1] > 0: + raise RuntimeError(f"Concatenating with a non duplicated surface, {idx_surf+1}!") + # Get the next mesh + mesh_dup = self.get_avl_fort_arr("SURF_MESH_R","MSHBLK",slicer=(slice(self.mesh_idx_first[idx_surf+1],self.mesh_idx_first[idx_surf+1]+nx*ny),slice(0,3))) + mesh_dup = mesh_dup.reshape((ny,nx,3)).transpose((1,0,2)) + mesh_dup[:,:,1] = -mesh_dup[:,:,1] + self.y_offsets[idx_surf-1] + + # Concatenate them + mesh = np.hstack([mesh,mesh_dup]) + + # Get iptloc + iptloc = None + if get_iptloc: + iptloc = self.get_avl_fort_arr("SURF_MESH_I","IPTSEC",slicer=(idx_surf,slice(None,self.get_num_sections(self.get_surface_names()[idx_surf])))) - 1 + return mesh, iptloc + else: + return mesh + + + # Only add +1 for Fortran indexing if we are not explictly telling the routine to use + # nspans by passing in all zeros + # if not (iptloc == 0).all(): + # iptloc += 1 + # # set iptloc + # self.set_avl_fort_arr("SURF_MESH_I","IPTSEC",iptloc,slicer=(idx_surf,slice(None,len(iptloc)))) + + # Compute and set the mesh starting index + # if idx_surf != 0: + # self.mesh_idx_first[idx_surf] = self.mesh_idx_first[idx_surf-1] + 3*(self.avl.SURF_GEOM_I.NVS[idx_surf-1]+1)*(self.avl.SURF_GEOM_I.NVC[idx_surf-1]+1) + + # self.set_avl_fort_arr("SURF_MESH_I","MFRST",self.mesh_idx_first[idx_surf]+1,slicer=idx_surf) + + # # Reshape the mesh + # # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0]*mesh.shape[1]), order="F") + # mesh = mesh.transpose((1,0,2)).reshape((mesh.shape[0]*mesh.shape[1],3)) + + # # Set the mesh + # self.set_avl_fort_arr("SURF_MESH_R","MSHBLK",mesh, slicer=(slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+nx*ny),slice(0,3))) + + + def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): """Sets the airfoil oml points for the specified surface and section. Computes camber lines, thickness, and oml shape from NACA 4-digit specification. @@ -3891,6 +3969,234 @@ def plot_geom(self, axes=None): plt.axis("equal") plt.show() + def add_mesh_plot_3d_avl( + self, + axis, + color: str = "black", + mesh_style="--", + mesh_linewidth=0.3, + show_mesh: bool = False, + show_control_points: bool = False + ): + """Adds a 3D plot of the aircraft mesh to a 3D axis + Always plots a flattened mesh from the AVL geometry definition or + a flattened version of any directly assigned meshes. + + Args: + axis: axis to add the plot to + color: what color should the mesh be + mesh_style: line style of the interior mesh, e.g. '-' or '--' + mesh_linewidth: width of the interior mesh, 1.0 will match the surface outline + show_mesh: flag to show the interior mesh of the geometry + """ + mesh_size = self.get_mesh_size() + num_control_surfs = self.get_num_control_surfs() + num_strips = self.get_num_strips() + num_surfs = self.get_num_surfaces() + + # get the mesh points for ploting + mesh_slice = (slice(0, mesh_size),) + strip_slice = (slice(0, num_strips),) + surf_slice = (slice(0, num_surfs),) + + rv1 = self.get_avl_fort_arr("VRTX_R", "RV1", slicer=mesh_slice) # Vortex Left points + rv2 = self.get_avl_fort_arr("VRTX_R", "RV2", slicer=mesh_slice) # Vortex Right points + rc = self.get_avl_fort_arr("VRTX_R", "RC", slicer=mesh_slice) # Control Points + rle1 = self.get_avl_fort_arr("STRP_R", "RLE1", slicer=strip_slice) # Strip left end LE point + rle2 = self.get_avl_fort_arr("STRP_R", "RLE2", slicer=strip_slice) # Strip right end LE point + chord1 = self.get_avl_fort_arr("STRP_R", "CHORD1", slicer=strip_slice) # Left strip chord + chord2 = self.get_avl_fort_arr("STRP_R", "CHORD2", slicer=strip_slice) # Right strip chord + jfrst = self.get_avl_fort_arr("SURF_I", "JFRST", slicer=surf_slice) # Index of first strip in surface + + ijfrst = self.get_avl_fort_arr("STRP_I", "IJFRST", slicer=strip_slice) # Index of first element in strip + nvstrp = self.get_avl_fort_arr("STRP_I", "NVSTRP", slicer=strip_slice) # Number of elements in strip + + nj = self.get_avl_fort_arr("SURF_I", "NJ", slicer=surf_slice) # Number of elements along span in surface + imags = self.get_avl_fort_arr("SURF_I", "IMAGS") # Is surface YDUPL one? + + for idx_surf in range(num_surfs): + # get the range of the elements that belong to this surfaces + strip_st = jfrst[idx_surf] - 1 + strip_end = strip_st + nj[idx_surf] + + # inboard and outboard of outline + # get surfaces that have not been duplicated + if imags[idx_surf] > 0: + j1 = strip_st + jn = strip_end - 1 + dj = 1 + else: + # this surface is a duplicate + j1 = strip_end - 1 + jn = strip_st + dj = -1 + + pts = { + "x": [rle1[j1, 0], rle1[j1, 0] + chord1[j1]], + "y": [rle1[j1, 1], rle1[j1, 1]], + "z": [rle1[j1, 2], rle1[j1, 2]], + } + # # chord-wise grid + axis.plot(pts['x'], pts['y'],pts['z'], color=color) + + pts = { + "x": np.array([rle2[jn, 0], rle2[jn, 0] + chord2[jn]]), + "y": np.array([rle2[jn, 1], rle2[jn, 1]]), + "z": np.array([rle2[jn, 2], rle2[jn, 2]]), + } + + # # chord-wise grid + axis.plot(pts['x'], pts['y'],pts['z'], color=color) + + # # --- outline of surface --- + # front + pts = { + "x": np.append(rle1[j1:jn:dj, 0], rle2[jn, 0]), + "y": np.append(rle1[j1:jn:dj, 1], rle2[jn, 1]), + "z": np.append(rle1[j1:jn:dj, 2], rle2[jn, 2]), + } + axis.plot(pts['x'], pts['y'],pts['z'],"-", color=color) + + # aft + + pts = { + "x": np.append(rle1[j1:jn:dj, 0] + chord1[j1:jn:dj], rle2[jn, 0] + chord2[jn]), + "y": np.append(rle1[j1:jn:dj, 1], rle2[jn, 1]), + "z": np.append(rle1[j1:jn:dj, 2], rle2[jn, 2]), + } + axis.plot(pts['x'], pts['y'],pts['z'],"-", color=color) + + if show_mesh: + for idx_strip in range(strip_st, strip_end): + if ((imags[idx_surf] > 0) and (idx_strip != strip_st)) or ( + (imags[idx_surf] < 0) and (idx_strip != strip_end) + ): + pts = { + "x": [rle1[idx_strip, 0], rle1[idx_strip, 0] + chord1[idx_strip]], + "y": [rle1[idx_strip, 1], rle1[idx_strip, 1]], + "z": [rle1[idx_strip, 2], rle1[idx_strip, 2]], + } + + # # chord-wise grid + axis.plot(pts['x'], pts['y'], pts['z'], mesh_style, color=color, alpha=1.0, linewidth=mesh_linewidth) + + vor_st = ijfrst[idx_strip] - 1 + vor_end = vor_st + nvstrp[idx_strip] + + # spanwise grid + for idx_vor in range(vor_st, vor_end): + pts = { + "x": [rv1[idx_vor, 0], rv2[idx_vor, 0]], + "y": [rv1[idx_vor, 1], rv2[idx_vor, 1]], + "z": [rv1[idx_vor, 2], rv2[idx_vor, 2]], + } + axis.plot(pts['x'], pts['y'],pts['z'], mesh_style, color=color, alpha=1.0, linewidth=mesh_linewidth) + + if show_control_points: + for idx_strip in range(strip_st, strip_end): + vor_st = ijfrst[idx_strip] - 1 + vor_end = vor_st + nvstrp[idx_strip] + + # spanwise grid + for idx_vor in range(vor_st, vor_end): + pts = { + "x": [rc[idx_vor, 0]], + "y": [rc[idx_vor, 1]], + "z": [rc[idx_vor, 2]], + } + axis.scatter(pts['x'], pts['y'], pts['z'],color='r', alpha=1.0, linewidth=0.1) + + def add_mesh_plot_3d_direct( + self, + axis, + color: str = "black", + mesh_style="--", + mesh_linewidth=0.3, + show_mesh: bool = False, + # show_avl_geom: bool = False, + # show_avl_mesh: bool = False, + # avl_mesh_color: str = "red", + # avl_mesh_style: str = "--", + # show_avl_control_points: bool = False + ): + """Plots the true mesh assigned to SURF_MESH AVL common block data on a 3D axis. + Can also plot the mesh stored in SURF on the same axis. + + Args: + axis: axis to add the plot to + color: what color should the mesh be + mesh_style: line style of the interior mesh, e.g. '-' or '--' + mesh_linewidth: width of the interior mesh, 1.0 will match the surface outline + show_mesh: flag to show the interior mesh of the geometry + """ + num_surfs = self.get_num_surfaces() + + for idx_surf in range(num_surfs): + # get the mesh block data + mesh = self.get_mesh(idx_surf) + mesh_x = mesh[:, :, 0] + mesh_y = mesh[:, :, 1] + mesh_z = mesh[:, :, 2] + + # Plot mesh outline + axis.plot(mesh_x[0, :], mesh_y[0, :], mesh_z[0, :], "-", color=color, lw=1) + axis.plot(mesh_x[-1, :], mesh_y[-1, :],mesh_z[-1, :], "-", color=color, lw=1) + axis.plot(mesh_x[:, 0], mesh_y[:, 0],mesh_z[:, 0], "-", color=color, lw=1) + axis.plot(mesh_x[:, -1], mesh_y[:, -1],mesh_z[:, -1], "-", color=color, lw=1) + + if show_mesh: + for i in range(mesh_x.shape[0]): + axis.plot(mesh_x[i, :], mesh_y[i, :], mesh_z[i, :], mesh_style, color=color, lw=mesh_linewidth, alpha=1.0) + for j in range(mesh_x.shape[1]): + axis.plot(mesh_x[:, j], mesh_y[:, j],mesh_z[:, j], mesh_style, color=color, lw=mesh_linewidth, alpha=1.0) + + # if show_avl_geom: + # self.add_mesh_plot_3d_avl( + # axis, + # color = avl_mesh_color, + # mesh_style=avl_mesh_style, + # mesh_linewidth=mesh_linewidth, + # show_mesh = show_avl_mesh, + # show_control_points = show_avl_control_points) + + def plot_geom_3d(self, axes=None, plot_avl_mesh = True, plot_direct_mesh = False): + """Generate a matplotlib plot of geometry + + Args: + axes: Matplotlib axis object to add the plots too. If none are given, the axes will be generated. + """ + + if axes == None: + import matplotlib.pyplot as plt + + ax1 = plt.subplot(projection='3d') + ax1.set_ylabel("X", rotation=0) + ax1.set_aspect("equal") + ax1._axis3don = False + plt.subplots_adjust(left=0.025, right=0.925, top=0.925, bottom=0.025) + else: + ax1, ax2 = axes + + if plot_avl_mesh: + self.add_mesh_plot_3d_avl(ax1, + color = "red", + mesh_style="--", + mesh_linewidth=1.0, + show_mesh= True, + show_control_points = False) + + if plot_direct_mesh: + self.add_mesh_plot_3d_direct(ax1, + color = "black", + mesh_style="--", + mesh_linewidth=0.3, + show_mesh= True) + + if axes == None: + # assume that if we don't provide axes that we want to see the plot + plt.axis("equal") + plt.show() + def get_cp_data(self) -> Tuple[List[np.ndarray], List[np.ndarray]]: """Gets the current surface mesh and cp distribution From 3637270487d6d007549140c8ad6ca77faa1bf01d Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Mon, 2 Feb 2026 01:17:49 -0500 Subject: [PATCH 24/49] New control definition implemention. section free --- config/defaults/config.MACOS_GFORTRAN.mk | 6 +- optvl/optvl_class.py | 170 +++++++++--------- optvl/utils/check_surface_dict.py | 208 +++++++++++++++-------- src/amake.f | 11 +- src/includes/AVL.INC.in | 2 +- 5 files changed, 236 insertions(+), 161 deletions(-) diff --git a/config/defaults/config.MACOS_GFORTRAN.mk b/config/defaults/config.MACOS_GFORTRAN.mk index faa3d9e..491c6bb 100644 --- a/config/defaults/config.MACOS_GFORTRAN.mk +++ b/config/defaults/config.MACOS_GFORTRAN.mk @@ -6,13 +6,11 @@ FF90 = gfortran -FF90_FLAGS = -fdefault-real-8 -fdefault-double-8 -O2 -fPIC -Wno-align-commons -std=legacy -C -mmacosx-version-min=13.6 -# FF90_FLAGS = -fdefault-real-8 -fdefault -double-8 -O0 -fPIC -Wno-align-commons -Werror=line-truncation -std=legacy -C -mmacosx-version-min=13.6 -g -fcheck=bounds -finit-real=snan -finit-integer=-999999 -ftrapping-math -ftrapv +# FF90_FLAGS = -fdefault-real-8 -fdefault-double-8 -O2 -fPIC -Wno-align-commons -std=legacy -C -mmacosx-version-min=13.6 +FF90_FLAGS = -fdefault-real-8 -fdefault -double-8 -O0 -fPIC -Wno-align-commons -Werror=line-truncation -std=legacy -C -mmacosx-version-min=13.6 -g -fcheck=bounds -finit-real=snan -finit-integer=-999999 -ftrapping-math -ftrapv C_FLAGS = -O2 -fPIC -mmacosx-version-min=13.6 - -F2PY = f2py F2PY_FF90 = gfortran PYTHON = python diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 02a765d..56dd713 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -270,7 +270,7 @@ def __init__( if mass_file is not None: self.avl.loadmass(mass_file) elif input_dict is not None: - self.load_input_dict(input_dict, postCheck=True) + self.load_input_dict(input_dict, post_check=True) self.avl.loadgeo("") else: raise ValueError("neither a geometry file nor an input options dictionary was specified") @@ -352,7 +352,7 @@ def _init_map_data(self): # we have to loop over the unique surfaces because those are the # only ones that have geometric data from the input file - # AVL only mirror the mesh data it doesn't infer the input data + # AVL only mirrors the mesh data it doesn't infer the input data # for the mirrored surface for surf_name in self.unique_surface_names: idx_surf = self.get_surface_index(surf_name) @@ -427,7 +427,7 @@ def _setup_surface_maps(self, surf_name:str, idx_surf:int, num_sec:int): "albe": ["SURF_L", "LFALBE", slice_idx_surf], "load": ["SURF_L", "LFLOAD", slice_idx_surf], } - + icontd_slices = [] idestd_slices = [] xhinged_slices = [] @@ -466,7 +466,7 @@ def _setup_surface_maps(self, surf_name:str, idx_surf:int, num_sec:int): "gaing": ["SURF_GEOM_R", "GAING", gaing_slices], } - + def _setup_body_maps(self, body_name:str, idx_body:int): """Used by the init_map_data and load_input_dict functions to generate which slices of the Fortran array for a given geometry or discretization variable correspond to the given body. This data is stored the @@ -536,14 +536,14 @@ def _setup_section_maps(self, surf_name:str, idx_surf:int, num_sec:int, nasec_ar "zlasec":["SURF_GEOM_R", "ZLASEC", zlasec_slices], } - def load_input_dict(self, input_dict: dict, preCheck: bool = True, postCheck: bool = False): + def load_input_dict(self, input_dict: dict, pre_check: bool = True, post_check: bool = False): """Reads and loads the input dictionary data into optvl. Equivalent to INPUT routine in AVL. Args: input_dict: input dictionary in optvl format - preCheck: perform additional verification of the user's input dictionary before loading into AVL - postCheck: verify certain inputs values are correctly reflected in the Fortran layer + pre_check: perform additional verification of the user's input dictionary before loading into AVL + post_check: verify certain inputs values are correctly reflected in the Fortran layer """ # Initialize Variables and Counters @@ -561,11 +561,11 @@ def load_input_dict(self, input_dict: dict, preCheck: bool = True, postCheck: bo self.set_avl_fort_arr("SURF_GEOM_R", "CLCDSRF", 0.0, slicer=(slice(None, 6), slice(None, self.NFMAX))) self.avl.CASE_L.LVISC = False self.set_avl_fort_arr("SURF_L", "LRANGE", True, slicer=slice(None, self.NFMAX)) - + # Perform pre-check of user's input dictionary before loading into AVL - if preCheck: + if pre_check: input_dict = pre_check_input_dict(input_dict) - + def get_types_from_blk(common_blk): """Determines the variable type a common block uses from its name @@ -600,29 +600,28 @@ def check_type(key, avl_vars, given_val): """ # get the type that it should be expected_type = get_types_from_blk(avl_vars[0]) - + # if the expected type is a str if expected_type is str: # check the type of the scaler if not isinstance(given_val, expected_type): raise TypeError(f"Variable {key} is of type {type(given_val)} but expected {expected_type}") - + # for strings no further checks are required return - - + # --- test shape and type of numeric vales--- current_val = self.get_avl_fort_arr(*avl_vars) - + # is the current value a scalar or a numpy array? if isinstance(current_val, np.ndarray): if not isinstance(given_val, np.ndarray): raise ValueError(f"Variable {key} is scalar, but optvl expected an array of shape {current_val.shape}") - + # compare the shapes if current_val.shape != val.shape: raise ValueError(f"Variable {key} is shape {given_val.shape}, but optvl expected an array of shape {current_val.shape}") - + # check that the type of the array matches the expectation if not isinstance(given_val.flatten()[0], expected_type): raise TypeError(f"Variable {key} is an array of type {given_val.dtype} but expected {expected_type}") @@ -630,7 +629,7 @@ def check_type(key, avl_vars, given_val): # check the type of the scaler if not isinstance(given_val, expected_type): raise TypeError(f"Variable {key} is a scalar of type {type(given_val)} but expected {expected_type}") - + # Set AVL header variables # CDp is the only optional input for the AVL header optional_header_defaults = { @@ -649,46 +648,45 @@ def check_type(key, avl_vars, given_val): val = self._str_to_fort_str(input_dict[key],num_max_char=120) else: val = input_dict[key] - + check_type(key, avl_vars, val) - + self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val) - - + self.set_avl_fort_arr("CASE_R", "YSYM", 0.0) # YSYM Hardcoded to 0 - + # set the global control variable options - ncontrol = len(input_dict.get("dname", [])) - if ncontrol > self.NDMAX: + num_controls = len(input_dict.get("dname", [])) + if num_controls > self.NDMAX: raise RuntimeError(f"Number of specified controls exceeds {self.NDMAX}. Raise NDMAX!") - self.set_avl_fort_arr("CASE_I","NCONTROL", ncontrol) + self.set_avl_fort_arr("CASE_I","NCONTROL", num_controls) - for k in range(ncontrol): + for k in range(num_controls): self.avl.CASE_C.DNAME[k] = input_dict["dname"][k] - + # set the gloabl design variable options - ndesign = len(input_dict.get("gname", [])) - self.set_avl_fort_arr("CASE_I","NDESIGN", ndesign) - if ndesign > self.NGMAX: + num_design = len(input_dict.get("gname", [])) + self.set_avl_fort_arr("CASE_I","NDESIGN", num_design) + if num_design > self.NGMAX: raise RuntimeError(f"Number of specified design variables exceeds {self.NGMAX}. Raise NGMAX!") - for k in range(ndesign): + for k in range(num_design): self.avl.CASE_C.GNAME[k] = input_dict["gname"][k] - + # Set total number of surfaces in one shot num_surfs = len(input_dict["surfaces"]) if num_surfs < self.NFMAX: - self.set_avl_fort_arr("CASE_I", "NSURF", num_surfs) # YSYM Hardcoded to 0 + self.set_avl_fort_arr("CASE_I", "NSURF", num_surfs) else: raise RuntimeError(f"Number of specified surfaces, {num_surfs}, exceeds {self.NFMAX}. Raise NFMAX!") - + # Class variable to store the starting index of all meshes. Set to 0 for no mesh. # We will insert entries into it for duplicate surfaces later but right now it's only for unique surfaces self.mesh_idx_first = np.zeros(self.get_num_surfaces(),dtype=np.int32) # Class variable to store the yoffset for duplicated meshes. This information is needed for correcting retreiving - # a duplicated mesh + # a duplicated mesh as its normally only passed as a dummy argument into the SDUPL subroutine and not stored in the fortran layer. self.y_offsets = np.zeros(self.get_num_surfaces(),dtype=np.float64) # Load surfaces @@ -703,45 +701,54 @@ def check_type(key, avl_vars, given_val): self.des_var_to_fort_var = {} idx_surf = 0 - - for surf_name in input_dict["surfaces"]: - + + for surf_name in input_dict["surfaces"]: + surf_dict = input_dict["surfaces"][surf_name] - + + + # MOVED TO PRECHECK ROUTINE + # For meshes set the number of "sections" to the number of strips in the mesh so that the slice maps are setup correctly + # if "mesh" in surf_dict.keys(): + # num_secs = surf_dict["mesh"].shape[1] - 1 + # else: num_secs = surf_dict["num_sections"] - # Set total number of sections in one shot - if num_secs < self.NSMAX: + + # Check how many strip/sections we have defined so far and that it doesn't exceed NSMAX + cur_secs = np.sum(self.get_avl_fort_arr("SURF_GEOM_I","NSEC")) + if cur_secs + num_secs < self.NSMAX: + # Set total number of sections in one shot self.set_avl_fort_arr("SURF_GEOM_I", "NSEC", num_secs, slicer=idx_surf) else: raise RuntimeError( - f"Number of specified sections for surface {surf_name} exceeds {self.NSMAX}. Raise NSMAX!" + f"Number of specified sections/strips exceeds {self.NSMAX}. Raise NSMAX!" ) - + # Set the number of control and design variables for the surface for idx_sec in range(num_secs): self.set_avl_fort_arr("SURF_GEOM_I", "NSCON", surf_dict["num_controls"][idx_sec], slicer=(idx_surf, idx_sec)) self.set_avl_fort_arr("SURF_GEOM_I", "NSDES", surf_dict["num_design_vars"][idx_sec], slicer=(idx_surf, idx_sec)) - - + + self._setup_surface_maps(surf_name, idx_surf, num_secs) - + # Set surface name self.avl.CASE_C.STITLE[idx_surf] = self._str_to_fort_str(surf_name, num_max_char=40) - + # fmt: off - + optional_surface_defaults = { - "nspan": 0, - "sspace": 0.0, - "use surface spacing": False, + "nspan": 0, + "sspace": 0.0, + "use surface spacing": False, "component": idx_surf+1, # +1 for 1-based indexing in fortran - "scale": np.array([1.,1.,1.]), - "translate": np.array([0.,0.,0.]), - "angle": 0.0, + "scale": np.array([1.,1.,1.]), + "translate": np.array([0.,0.,0.]), + "angle": 0.0, "aincs": np.zeros(num_secs, dtype=np.float64), - "wake": True, - "albe": True, - "load": True, + "wake": True, + "albe": True, + "load": True, "clcd": np.zeros(6, dtype=np.float64), "nspans": np.zeros(num_secs, dtype=np.int32), "sspaces": np.zeros(num_secs, dtype=np.float64), @@ -763,29 +770,29 @@ def check_type(key, avl_vars, given_val): } # fmt: on - + # set some flags based on the options used for this surface - if "sspace" in surf_dict: + if ("sspace" in surf_dict) and ("mesh" not in surf_dict): self.set_avl_fort_arr("SURF_GEOM_L", "LSURFSPACING", True, slicer=idx_surf) else: self.set_avl_fort_arr("SURF_GEOM_L", "LSURFSPACING", False, slicer=idx_surf) - + if "yduplicate" in surf_dict: self.set_avl_fort_arr("SURF_GEOM_L", "LDUPL", True, slicer=idx_surf) else: self.set_avl_fort_arr("SURF_GEOM_L", "LDUPL", False, slicer=idx_surf) - + if "clcd" in surf_dict or 'clcdsec' in surf_dict: # if any of the surfaces use clcd then turn on viscous loads self.set_avl_fort_arr("CASE_L", "LVISC", True) - + # lhinge = False Appears in AVL but does nothing for key, avl_vars in chain( self.surf_geom_to_fort_var[surf_name].items(), self.surf_pannel_to_fort_var[surf_name].items() ): - + if key not in surf_dict: if (key == "yduplicate") or (("mesh" in surf_dict) and (key in ignore_if_mesh)): continue @@ -795,9 +802,9 @@ def check_type(key, avl_vars, given_val): raise ValueError(f"Key {key} not found in surface dictionary, {surf_name}, but is required") else: val = surf_dict[key] - - check_type(key, avl_vars, val) - + + check_type(key, avl_vars, val) + self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val, slicer=avl_vars[2]) # determine what method of airfoil definition we are using @@ -897,20 +904,20 @@ def check_type(key, avl_vars, given_val): for key, avl_vars in self.con_surf_to_fort_var[surf_name].items(): avl_vars_secs = self.con_surf_to_fort_var[surf_name][key] avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][idx_sec]) - + if key not in surf_dict: raise ValueError(f"Key {key} not found in surf dictionary, `{surf_name}` but is required") else: # This has to be incremented by 1 for Fortran indexing if key == "icontd": - val = surf_dict[key][idx_sec] + 1 + val = np.array(surf_dict[key][idx_sec],dtype=np.int32) + 1 else: - val = surf_dict[key][idx_sec] - + val = np.array(surf_dict[key][idx_sec],dtype=np.float64) + check_type(key, avl_vars, val) self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val, slicer=avl_vars[2]) - + # --- setup design variables for each section --- # Load design variables @@ -919,25 +926,24 @@ def check_type(key, avl_vars, given_val): # check to make sure this section has control vars if surf_dict["num_design_vars"][idx_sec] == 0: continue - + for key, avl_vars in self.des_var_to_fort_var[surf_name].items(): avl_vars_secs = self.des_var_to_fort_var[surf_name][key] avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][idx_sec]) - + if key not in surf_dict: raise ValueError(f"Key {key} not found in surf dictionary, `{surf_name}` but is required") else: # This has to be incremented by 1 for Fortran indexing if key == "idestd": - val = surf_dict[key][idx_sec] + 1 + val = np.array(surf_dict[key][idx_sec],dtype=np.int32) + 1 else: - val = surf_dict[key][idx_sec] - + val = np.array(surf_dict[key][idx_sec],dtype=np.float64) + check_type(key, avl_vars, val) self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val, slicer=avl_vars[2]) - - + # Make the surface if self.debug: print(f"Building surface: {surf_name}") @@ -954,7 +960,7 @@ def check_type(key, avl_vars, given_val): self.avl.makesurf_mesh(idx_surf + 1) #+1 for Fortran indexing else: self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing - + if "yduplicate" in surf_dict.keys(): self.avl.sdupl(idx_surf + 1, surf_dict["yduplicate"], "YDUP") # Insert duplicate into the mesh first index array @@ -965,7 +971,7 @@ def check_type(key, avl_vars, given_val): # Keep python data consistent with Fortran surf_names.insert(idx_surf + 1, surf_name) - + idx_surf += 1 # Set total number of bodies in one shot @@ -1045,7 +1051,7 @@ def check_type(key, avl_vars, given_val): idx_body += 1 - if postCheck: + if post_check: self.post_check_input(input_dict) if self.debug: diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index cc4c1f2..c94752c 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -17,6 +17,28 @@ # Extension modules # ============================================================================= +def scalar_to_strip_vec(given_val,num_secs): + """Converts a scalar into a numpy array of length matching + the number of sections. If a numpy array of length not matching + the number of sections is input then an exception is thrown. + + Args: + given_val: Input value + num_secs: Number of sections + + Returns: + np.ndarray of length number of sections + """ + # check if we input a scalar + if not isinstance(given_val, np.ndarray): + return given_val*np.ones(num_secs) + elif isinstance(given_val,np.ndarray): + if given_val.shape[0] != num_secs: + raise ValueError("The length of a given surface/body input must either be a scalar or match the number of sections!") + return given_val + else: + return given_val + def pre_check_input_dict(input_dict: dict): """ @@ -111,12 +133,14 @@ def pre_check_input_dict(input_dict: dict): "iptloc", "flatten_mesh", # Control Surfaces - # "dname" # IMPLEMENT THIS + "control_assignments", "icontd", # control variable index "xhinged", # x/c location of hinge "vhinged", # vector giving hinge axis about which surface rotates "gaind", # control surface gain "refld", # control surface reflection, sign of deflection for duplicated surface + # Design Variables + "design_var_assignments", "idestd", # design variable index "gaing", # desgin variable gain ] @@ -164,6 +188,11 @@ def pre_check_input_dict(input_dict: dict): "refld", # control surface reflection, sign of deflection for duplicated surface ] + design_var_keys =[ + "idestd", + "gaing", # design variable surface gain + ] + dim_2_keys = [ "clcdsec", @@ -187,7 +216,7 @@ def pre_check_input_dict(input_dict: dict): if key in ["Bref", "Sref", "Cref"]: if input_dict[key] < 0.0: raise ValueError(f"Reference value {key} cannot be negative!") - + # Correct incorrect symmetry plane defs with warning if key in ["iysym", "izsym"]: if input_dict[key] not in [-1,0,1]: @@ -206,65 +235,129 @@ def pre_check_input_dict(input_dict: dict): stacklevel=2, ) - total_global_control = 0 - total_global_design_var = 0 if "surfaces" in input_dict.keys(): if len(input_dict["surfaces"]) > 0: for surface in input_dict["surfaces"].keys(): # Check if we are directly providing a mesh + # if "mesh" in input_dict["surfaces"][surface].keys(): + # # Check if sections are specified + # if "num_sections" in input_dict["surfaces"][surface].keys(): + # # Check if the section indices are provided + # if "iptloc" in input_dict["surfaces"][surface].keys(): + # # If they are make sure we provide one for every section + # if len(input_dict["surfaces"][surface]["iptloc"]) != input_dict["surfaces"][surface]["num_sections"]: + # raise ValueError("iptloc vector length does not match num_sections") + # # Check if the user provided nspans instead + # elif "nspans" in input_dict["surfaces"][surface].keys(): + # # setting iptloc to 0 is how we tell the Fortran layer to use nspans + # input_dict["surfaces"][surface]["iptloc"] = np.zeros(input_dict["surfaces"][surface]["num_sections"]) + # # The OptVL class will have to call the fudging routine to try and auto cut the mesh into sections + # else: + # warnings.warn( + # "Mesh provided for surface dict `{}` for {} sections but locations not defined.\n OptVL will automatically define section locations as close to equally as possible.".format( + # surface, input_dict["surfaces"][surface]["num_sections"] + # ), + # category=RuntimeWarning, + # stacklevel=2, + # ) + # else: + # # Assume we have two sections at the ends of mesh and inform the user + # warnings.warn( + # "Mesh provided for surface dict `{}` but no sections provided.\n Assuming 2 sections at tips.".format( + # surface + # ), + # category=RuntimeWarning, + # stacklevel=2, + # ) + # input_dict["surfaces"][surface]["iptloc"] = np.array([0,input_dict["surfaces"][surface]["mesh"].shape[1]-1],dtype=np.int32) + # input_dict["surfaces"][surface]["num_sections"] = 2 + if "mesh" in input_dict["surfaces"][surface].keys(): - # Check if sections are specified - if "num_sections" in input_dict["surfaces"][surface].keys(): - # Check if the section indices are provided - if "iptloc" in input_dict["surfaces"][surface].keys(): - # If they are make sure we provide one for every section - if len(input_dict["surfaces"][surface]["iptloc"]) != input_dict["surfaces"][surface]["num_sections"]: - raise ValueError("iptloc vector length does not match num_sections") - # Check if the user provided nspans instead - elif "nspans" in input_dict["surfaces"][surface].keys(): - # setting iptloc to 0 is how we tell the Fortran layer to use nspans - input_dict["surfaces"][surface]["iptloc"] = np.zeros(input_dict["surfaces"][surface]["num_sections"]) - # The OptVL class will have to call the fudging routine to try and auto cut the mesh into sections - else: - warnings.warn( - "Mesh provided for surface dict `{}` for {} sections but locations not defined.\n OptVL will automatically define section locations as close to equally as possible.".format( - surface, input_dict["surfaces"][surface]["num_sections"] - ), - category=RuntimeWarning, - stacklevel=2, - ) - else: - # Assume we have two sections at the ends of mesh and inform the user - warnings.warn( - "Mesh provided for surface dict `{}` but no sections provided.\n Assuming 2 sections at tips.".format( - surface - ), - category=RuntimeWarning, - stacklevel=2, - ) - input_dict["surfaces"][surface]["iptloc"] = np.array([0,input_dict["surfaces"][surface]["mesh"].shape[1]-1],dtype=np.int32) - input_dict["surfaces"][surface]["num_sections"] = 2 + # First check if the mesh is a valid numpy array shape + if len(input_dict["surfaces"][surface]["mesh"].shape) != 3: + raise ValueError("The provided mesh must be a numpy array of size (nx,ny,3)") + # If we are using a mesh then set number of sections equal to number of strip for the purposes of intialization + input_dict["surfaces"][surface]["num_sections"] = input_dict["surfaces"][surface]["mesh"].shape[1] # Verify at least two section if input_dict["surfaces"][surface]["num_sections"] < 2: raise RuntimeError("Must have at least two sections per surface!") - - # if no controls are specified then fill it in with 0s - if "num_controls" not in input_dict["surfaces"][surface].keys(): + + # Read and process the controls dictionary + if "control_assignments" in input_dict["surfaces"][surface]: + num_controls_per_sec = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) + + for control in input_dict["surfaces"][surface]["control_assignments"]: + if control not in input_dict["dname"]: + raise ValueError(f"Control {control}, in surface {surface} not defined in dname!") + + # built the control data lists if needed + if "icontd" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["icontd"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + if "xhinged" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["xhinged"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + if "vhinged" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["vhinged"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + if "gaind" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["gaind"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + if "refld" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["refld"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + + # Add one to the number of controls defined for each section + sec_assign = input_dict["surfaces"][surface]["control_assignments"][control]["assignment"] + num_controls_per_sec[sec_assign] += 1 + # assign data to sections + for idx_sec in input_dict["surfaces"][surface]["control_assignments"][control]["assignment"]: + input_dict["surfaces"][surface]["icontd"][idx_sec].append(input_dict["dname"].index(control)) # Add control index to icontd for each section + input_dict["surfaces"][surface]["xhinged"][idx_sec].append(input_dict["surfaces"][surface]["control_assignments"][control]["xhinged"]) # Add hinge line position + input_dict["surfaces"][surface]["vhinged"][idx_sec].append(input_dict["surfaces"][surface]["control_assignments"][control]["vhinged"]) # Add hinge vector position + input_dict["surfaces"][surface]["gaind"][idx_sec].append(input_dict["surfaces"][surface]["control_assignments"][control]["gaind"]) # Add gain information + input_dict["surfaces"][surface]["refld"][idx_sec].append(input_dict["surfaces"][surface]["control_assignments"][control]["refld"]) # Add reflection information + + # set the control numbers per section + input_dict["surfaces"][surface]["num_controls"] = num_controls_per_sec + elif "num_controls" not in input_dict["surfaces"][surface]: + # Otherwise if we are not manually specifying controls then zero out the num_controls array input_dict["surfaces"][surface]["num_controls"] = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) - # if no dvs are specified then fill it in with 0s - if "num_design_vars" not in input_dict["surfaces"][surface].keys(): + # Read and process the design variables dictionary + if "design_var_assignments" in input_dict["surfaces"][surface]: + num_design_vars_per_sec = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) + + for design_var in input_dict["surfaces"][surface]["design_var_assignments"]: + if design_var not in input_dict["gname"]: + raise ValueError(f"Design Variable {design_var}, in surface {surface} not defined in gname!") + + # built the control data lists if needed + if "idestd" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["idestd"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + if "gaing" not in input_dict["surfaces"][surface]: + input_dict["surfaces"][surface]["gaing"] = [[] for _ in range(input_dict["surfaces"][surface]["num_sections"])] + + + # Add one to the number of controls defined for each section + sec_assign = input_dict["surfaces"][surface]["design_var_assignments"][design_var]["assignment"] + num_design_vars_per_sec[sec_assign] += 1 + # assign data to sections + for idx_sec in input_dict["surfaces"][surface]["design_var_assignments"][design_var]["assignment"]: + input_dict["surfaces"][surface]["idestd"][idx_sec].append(input_dict["gname"].index(design_var)) # Add design var index to idestd for each section + input_dict["surfaces"][surface]["gaing"][idx_sec].append(input_dict["surfaces"][surface]["design_var_assignments"][design_var]["gaing"]) # Add gain information + + # set the control numbers per section + input_dict["surfaces"][surface]["num_design_vars"] = num_design_vars_per_sec + elif "num_design_vars" not in input_dict["surfaces"][surface]: + # Otherwise if we are not manually specifying controls then zero out the num_design_vars array input_dict["surfaces"][surface]["num_design_vars"] = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) - + + #Checks to see that at most only one of the options in af_load_ops or one of the options in manual_af_override is selected if len(airfoil_spec_keys & input_dict["surfaces"][surface].keys()) > 1: raise RuntimeError( "More than one airfoil section specification detected in input dictionary!\n" "Select only a single approach for specifying airfoil sections!") - + for key in input_dict["surfaces"][surface].keys(): # Check to verify if redundant y-symmetry specification are not made @@ -306,50 +399,27 @@ def pre_check_input_dict(input_dict: dict): for j in range(input_dict["surfaces"][surface]["num_sections"]): for _ in range(input_dict["surfaces"][surface]["num_controls"][j]): if ( - input_dict["surfaces"][surface][key][j].shape[0] + len(input_dict["surfaces"][surface][key][j]) != input_dict["surfaces"][surface]["num_controls"][j] ): raise ValueError( f"Key {key} does not have entries corresponding to each control for this section!" ) - # Accumulate icont max - if "icontd" in input_dict["surfaces"][surface].keys(): - arr = input_dict["surfaces"][surface]["icontd"] - vals = [a.max() + 1 for a in arr if a.size > 0] - total_global_control = max(vals) if vals else None - # total_global_control = np.max(input_dict["surfaces"][surface]["icontd"])+1 # Check if dvs defined correctly - if key in control_keys: + if key in design_var_keys: for j in range(input_dict["surfaces"][surface]["num_sections"]): for _ in range(input_dict["surfaces"][surface]["num_design_vars"][j]): if ( - input_dict["surfaces"][surface][key][j].shape[0] + len(input_dict["surfaces"][surface][key][j]) != input_dict["surfaces"][surface]["num_design_vars"][j] ): raise ValueError( f"Key {key} does not have entries corresponding to each design var for this section!" ) - # Accumulate idestd max - if "idestd" in input_dict["surfaces"][surface].keys(): - arr = input_dict["surfaces"][surface]["idestd"] - vals = [a.max() + 1 for a in arr if a.size > 0] - total_global_design_var = max(vals) if vals else None - # total_global_design_var = np.max(input_dict["surfaces"][surface]["idestd"])+1 - - if "icontd" in input_dict["surfaces"][surface].keys(): - if len(input_dict["dname"]) != (total_global_control): - raise ValueError( - "Number of unique control names does not match the number of unique controls defined!" - ) - - if "idestd" in input_dict["surfaces"][surface].keys(): - if len(input_dict["gname"]) != (total_global_design_var): - raise ValueError( - "Number of unique design vars does not match the number of unique controls defined!" - ) + else: # Add dummy entry if surfaces are not defined input_dict["surfaces"] = {} diff --git a/src/amake.f b/src/amake.f index 00ea9b2..2acbfa1 100644 --- a/src/amake.f +++ b/src/amake.f @@ -920,7 +920,7 @@ subroutine makesurf_mesh(isurf) ! Store the spanwise index of each section in each surface DO ISEC = 1, NSEC(ISURF) II = ICNTFRST(ISURF) + (ISEC-1) - ICNTSEC(II) = IPTSEC(ISEC,isurf) + ICNTSEC(II) = idx_strip !IPTSEC(ISEC,isurf) ENDDO @@ -1474,12 +1474,13 @@ subroutine makesurf_mesh(isurf) ! of the element on the control surface do N = 1, NCONTROL !scale control gain by factor 0..1, (fraction of element on control surface) - FRACLE = (XLED(N)/CHORD(idx_strip)-((mesh_surf(1,idx_node_yp1) - & -mesh_surf(1,idx_node))/2.)/CHORD(idx_strip)) / + xpt = ((mesh_surf(1,idx_node)+mesh_surf(1,idx_node_yp1)) + & /2 - RLE(1,idx_strip))/CHORD(idx_strip) + + FRACLE = (XLED(N)/CHORD(idx_strip)-xpt) / & (DXV(idx_vor)/CHORD(idx_strip)) - FRACTE = (XTED(N)/CHORD(idx_strip)-((mesh_surf(1,idx_node_yp1) - & -mesh_surf(1,idx_node))/2.)/CHORD(idx_strip)) / + FRACTE = (XTED(N)/CHORD(idx_strip)-xpt) / & (DXV(idx_vor)/CHORD(idx_strip)) FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) diff --git a/src/includes/AVL.INC.in b/src/includes/AVL.INC.in index e436046..58d8e9b 100644 --- a/src/includes/AVL.INC.in +++ b/src/includes/AVL.INC.in @@ -495,7 +495,7 @@ c & VHINGED(3, ICONX, NSMAX, NFMAX), ! hinge vector & GAIND(ICONX, NSMAX, NFMAX), ! control surface gain & REFLD(ICONX, NSMAX, NFMAX), ! control surface reflection - & GAING(ICONX, NSMAX, NFMax) ! desgin variable gain + & GAING(ICONX, NSMAX, NFMAX) ! desgin variable gain COMMON /SURF_MESH_I/ & MFRST(NFMAX), ! stores the index in the MSHBLK where each surface's mesh begins From 469a6671b7b0b4d7599cfa8e0fa887692f6ac73a Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Mon, 2 Feb 2026 02:21:59 -0500 Subject: [PATCH 25/49] removing section loop from amake.wip --- src/amake.f | 75 ++++++++++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 35 deletions(-) diff --git a/src/amake.f b/src/amake.f index 2acbfa1..a9da665 100644 --- a/src/amake.f +++ b/src/amake.f @@ -954,29 +954,34 @@ subroutine makesurf_mesh(isurf) STOP ENDIF + ! New Loop over all strip in surface + do ispan = 1,ny-1 + ! Loop over sections - do idx_sec = 1, NSEC(isurf)-1 + ! do idx_sec = 1, NSEC(isurf)-1 ! Set reference information for the section - iptl = IPTSEC(idx_sec,isurf) - iptr = IPTSEC(idx_sec+1,isurf) - nspan = iptr - iptl - NJ(isurf) = NJ(isurf) + nspan + ! iptl = IPTSEC(idx_sec,isurf) + ! iptr = IPTSEC(idx_sec+1,isurf) + iptl = idx_strip + iptr = idx_strip + 1 + ! nspan = iptr - iptl + NJ(isurf) = NJ(isurf) + 1 ! nspan ! We need to compute the chord and claf values at the left and right edge of the section ! These will be needed by AVL for control surface setup and control point placement - idx_node = flatidx(1,iptl,isurf) - idx_node_nx = flatidx(nx,iptl,isurf) - CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 - & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) - idx_node = flatidx(1,iptr,isurf) - idx_node_nx = flatidx(nx,iptr,isurf) - CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 - & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) - CLAFL = CLAF(idx_sec, isurf) - CLAFR = CLAF(idx_sec+1,isurf) +! idx_node = flatidx(1,iptl,isurf) +! idx_node_nx = flatidx(nx,iptl,isurf) +! CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 +! & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) +! idx_node = flatidx(1,iptr,isurf) +! idx_node_nx = flatidx(nx,iptr,isurf) +! CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 +! & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) +! CLAFL = CLAF(idx_sec, isurf) +! CLAFR = CLAF(idx_sec+1,isurf) ! Compute the incidence angle at the section end points ! We will need this later to iterpolate chord projections @@ -992,23 +997,23 @@ subroutine makesurf_mesh(isurf) ! AINCS. However, when we twist we make sure to keep the leading and trailing edges ! linear (straight line along the LE and TE). The angles at each strip required to ! do are what gets applied to the normal vector at each strip. - AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR - AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR - CHSINL = CHORDL*SIN(AINCL) - CHSINR = CHORDR*SIN(AINCR) - CHCOSL = CHORDL*COS(AINCL) - CHCOSR = CHORDR*COS(AINCR) + ! AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR + ! AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR + ! CHSINL = CHORDL*SIN(AINCL) + ! CHSINR = CHORDR*SIN(AINCR) + ! CHCOSL = CHORDL*COS(AINCL) + ! CHCOSR = CHORDR*COS(AINCR) ! We need to determine which controls belong to this section ! Bring over the routine for this from makesurf DO N = 1, NCONTROL ISCONL(N) = 0 ISCONR(N) = 0 - DO ISCON = 1, NSCON(idx_sec,isurf) - IF(ICONTD(ISCON,idx_sec,isurf) .EQ.N) ISCONL(N) = ISCON + DO ISCON = 1, NSCON(idx_strip,isurf) + IF(ICONTD(ISCON,idx_strip,isurf) .EQ.N) ISCONL(N) = ISCON ENDDO - DO ISCON = 1, NSCON(idx_sec+1,isurf) - IF(ICONTD(ISCON,idx_sec+1,isurf).EQ.N) ISCONR(N) = ISCON + DO ISCON = 1, NSCON(idx_strip+1,isurf) + IF(ICONTD(ISCON,idx_strip+1,isurf).EQ.N) ISCONR(N) = ISCON ENDDO ENDDO @@ -1021,17 +1026,17 @@ subroutine makesurf_mesh(isurf) CHCOSL_G(N) = 0. CHCOSR_G(N) = 0. - DO ISDES = 1, NSDES(idx_sec,isurf) - IF(IDESTD(ISDES,idx_sec,isurf).EQ.N) THEN - CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_sec,isurf)*DTR - CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_sec,isurf)*DTR + DO ISDES = 1, NSDES(idx_strip,isurf) + IF(IDESTD(ISDES,idx_strip,isurf).EQ.N) THEN + CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_strip,isurf)*DTR + CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_strip,isurf)*DTR ENDIF ENDDO - DO ISDES = 1, NSDES(idx_sec+1,isurf) - IF(IDESTD(ISDES,idx_sec+1,isurf).EQ.N) THEN - CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_sec+1,isurf)*DTR - CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_sec+1,isurf)*DTR + DO ISDES = 1, NSDES(idx_strip+1,isurf) + IF(IDESTD(ISDES,idx_strip+1,isurf).EQ.N) THEN + CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_strip+1,isurf)*DTR + CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_strip+1,isurf)*DTR ENDIF ENDDO ENDDO @@ -1043,7 +1048,7 @@ subroutine makesurf_mesh(isurf) ! to use the leading edge positions and chords from the original input mesh ! Loop over strips in section - do ispan = 1,nspan + ! do ispan = 1,nspan idx_y = idx_strip - JFRST(isurf) + 1 ! Strip left side @@ -1558,7 +1563,7 @@ subroutine makesurf_mesh(isurf) idx_strip = idx_strip + 1 end do ! End strip loop - end do ! End section loop + ! end do ! End section loop ! Compute the wetted area and cave from the true mesh sum = 0.0 From 8aa02da3434916a6f87864f9c05ab497760d150e Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 2 Feb 2026 19:18:51 -0500 Subject: [PATCH 26/49] Complete rework of fortran subroutines for custom meshes --- optvl/utils/check_surface_dict.py | 59 +++++++--- src/amake.f | 183 ++++++++++++++++++++---------- 2 files changed, 164 insertions(+), 78 deletions(-) diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index c94752c..c18c92f 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -11,6 +11,7 @@ # External Python modules # ============================================================================= import numpy as np +import pdb # ============================================================================= @@ -161,6 +162,12 @@ def pre_check_input_dict(input_dict: dict): "sspaces", # spanwise spacing vector (for each section), overriden by sspace "clcdsec", # profile-drag CD(CL) function for each section in this surface "claf", # CL alpha (dCL/da) scaling factor per section + # Geometry + "xles", # leading edge cordinate vector(x component) + "yles", # leading edge cordinate vector(y component) + "zles", # leading edge cordinate vector(z component) + "chords", # chord length vector + "aincs", # incidence angle vector # Geometry: Cross Sections # NACA "naca", @@ -357,7 +364,7 @@ def pre_check_input_dict(input_dict: dict): "More than one airfoil section specification detected in input dictionary!\n" "Select only a single approach for specifying airfoil sections!") - + # Process all keys for key in input_dict["surfaces"][surface].keys(): # Check to verify if redundant y-symmetry specification are not made @@ -367,22 +374,44 @@ def pre_check_input_dict(input_dict: dict): f"ERROR: Redundant y-symmetry specifications in surface {surface} \nIYSYM /= 0 \nYDUPLICATE 0.0. \nCan use one or the other, but not both!" ) - # Check the surface input size is a 2D array with second dim equal to num_sections + # Verify that keys that need items specified for every strip/section have value specified for all strip/section or have a scalar/single vector that can be duplicated if key in multi_section_keys: - if (key in dim_2_keys) and (input_dict["surfaces"][surface][key].ndim != 2): - raise ValueError( - f"Key {key} is of dimension {input_dict['surfaces'][surface][key].ndim}, expected 2!" - ) - if (key not in dim_2_keys) and input_dict["surfaces"][surface][key].ndim != 1: - raise ValueError( - f"Key {key} is of dimension {input_dict['surfaces'][surface][key].ndim}, expected 1!" - ) - if ( - input_dict["surfaces"][surface][key].shape[0] - != input_dict["surfaces"][surface]["num_sections"] - ): - raise ValueError(f"Key {key} does not have entries corresponding to each section!s") + if (key in dim_2_keys): + if not (isinstance(input_dict["surfaces"][surface][key],np.ndarray)): + raise ValueError(f"Input for {key} must be a single dim 1 numpy array or a dim 2 numpy array with each vector along axis 0 corresponding to strip/section") + + # If the user provides a single dim 1 vector stack it num_sections times + if (input_dict["surfaces"][surface][key].ndim == 1): + input_dict["surfaces"][surface][key] = np.tile(input_dict["surfaces"][surface][key],(input_dict["surfaces"][surface]["num_sections"],1)) + # Otherwise make sure we have entries for each seciton + elif (input_dict["surfaces"][surface][key].ndim == 2): + if (input_dict["surfaces"][surface][key].shape[0] != input_dict["surfaces"][surface]["num_sections"]): + raise ValueError( + f"Key {key} only has {input_dict['surfaces'][surface][key].shape[0]}, expected {input_dict['surfaces'][surface]['num_sections']}!" + ) + else: + raise ValueError( + f"Key {key} is of dimension {input_dict['surfaces'][surface][key].ndim}, expected 1 or 2!" + ) + else: + + # If the user provides a scalar expand it out for all sections + if isinstance(input_dict["surfaces"][surface][key],(int,float,np.int32,np.float64)): + input_dict["surfaces"][surface][key] = np.tile(input_dict["surfaces"][surface][key],(input_dict["surfaces"][surface]["num_sections"])) + elif input_dict["surfaces"][surface][key].ndim > 1: + raise ValueError( + f"Key {key} is of dimension {input_dict['surfaces'][surface][key].ndim}, expected 1!" + ) + + + + # if ( + # input_dict["surfaces"][surface][key].shape[0] + # != input_dict["surfaces"][surface]["num_sections"] + # ): + # # Expand scalars to t + # raise ValueError(f"Key {key} does not have entries corresponding to each section!s") # Check for keys not implemented if key not in keys_implemented_surface: diff --git a/src/amake.f b/src/amake.f index a9da665..295d184 100644 --- a/src/amake.f +++ b/src/amake.f @@ -954,7 +954,7 @@ subroutine makesurf_mesh(isurf) STOP ENDIF - ! New Loop over all strip in surface + ! New Loop over all strips in surface do ispan = 1,ny-1 @@ -972,16 +972,16 @@ subroutine makesurf_mesh(isurf) ! We need to compute the chord and claf values at the left and right edge of the section ! These will be needed by AVL for control surface setup and control point placement -! idx_node = flatidx(1,iptl,isurf) -! idx_node_nx = flatidx(nx,iptl,isurf) -! CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 -! & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) -! idx_node = flatidx(1,iptr,isurf) -! idx_node_nx = flatidx(nx,iptr,isurf) -! CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 -! & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) -! CLAFL = CLAF(idx_sec, isurf) -! CLAFR = CLAF(idx_sec+1,isurf) + idx_node = flatidx(1,iptl,isurf) + idx_node_nx = flatidx(nx,iptl,isurf) + CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 + & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) + idx_node = flatidx(1,iptr,isurf) + idx_node_nx = flatidx(nx,iptr,isurf) + CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 + & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) + CLAFL = CLAF(idx_strip, isurf) + CLAFR = CLAF(idx_strip+1,isurf) ! Compute the incidence angle at the section end points ! We will need this later to iterpolate chord projections @@ -997,12 +997,12 @@ subroutine makesurf_mesh(isurf) ! AINCS. However, when we twist we make sure to keep the leading and trailing edges ! linear (straight line along the LE and TE). The angles at each strip required to ! do are what gets applied to the normal vector at each strip. - ! AINCL = AINCS(idx_sec,isurf)*DTR + ADDINC(isurf)*DTR - ! AINCR = AINCS(idx_sec+1,isurf)*DTR + ADDINC(isurf)*DTR - ! CHSINL = CHORDL*SIN(AINCL) - ! CHSINR = CHORDR*SIN(AINCR) - ! CHCOSL = CHORDL*COS(AINCL) - ! CHCOSR = CHORDR*COS(AINCR) + AINCL = AINCS(idx_strip,isurf)*DTR + ADDINC(isurf)*DTR + AINCR = AINCS(idx_strip+1,isurf)*DTR + ADDINC(isurf)*DTR + CHSINL = CHORDL*SIN(AINCL) + CHSINR = CHORDR*SIN(AINCR) + CHCOSL = CHORDL*COS(AINCL) + CHCOSR = CHORDR*COS(AINCR) ! We need to determine which controls belong to this section ! Bring over the routine for this from makesurf @@ -1168,14 +1168,14 @@ subroutine makesurf_mesh(isurf) ELSE ! control variable # N is active here - GAINDA(N) = GAIND(ICL,idx_sec ,isurf)*(1.0-FC) - & + GAIND(ICR,idx_sec+1,isurf)* FC + GAINDA(N) = GAIND(ICL,idx_strip ,isurf)*(1.0-FC) + & + GAIND(ICR,idx_strip+1,isurf)* FC ! SAB Note: This interpolation ensures that the hinge line is ! is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware ! A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord - XHD = CHORDL*XHINGED(ICL,idx_sec ,isurf)*(1.0-FC) - & + CHORDR*XHINGED(ICR,idx_sec+1,isurf)* FC + XHD = CHORDL*XHINGED(ICL,idx_strip ,isurf)*(1.0-FC) + & + CHORDR*XHINGED(ICR,idx_strip+1,isurf)* FC IF(XHD.GE.0.0) THEN ! TE control surface, with hinge at XHD XLED(N) = XHD @@ -1186,18 +1186,18 @@ subroutine makesurf_mesh(isurf) XTED(N) = -XHD ENDIF - VHX = VHINGED(1,ICL,idx_sec,isurf)*XYZSCAL(1,isurf) - VHY = VHINGED(2,ICL,idx_sec,isurf)*XYZSCAL(2,isurf) - VHZ = VHINGED(3,ICL,idx_sec,isurf)*XYZSCAL(3,isurf) + VHX = VHINGED(1,ICL,idx_strip,isurf)*XYZSCAL(1,isurf) + VHY = VHINGED(2,ICL,idx_strip,isurf)*XYZSCAL(2,isurf) + VHZ = VHINGED(3,ICL,idx_strip,isurf)*XYZSCAL(3,isurf) VSQ = VHX**2 + VHY**2 + VHZ**2 IF(VSQ.EQ.0.0) THEN ! default: set hinge vector along hingeline ! We are just setting the hinge line across the section ! this assumes the hinge is linear even for a nonlinear wing VHX = mesh_surf(1,idx_noder) - & + ABS(CHORDR*XHINGED(ICR,idx_sec+1,isurf)) + & + ABS(CHORDR*XHINGED(ICR,idx_strip+1,isurf)) & - mesh_surf(1,idx_nodel) - & - ABS(CHORDL*XHINGED(ICL,idx_sec,isurf)) + & - ABS(CHORDL*XHINGED(ICL,idx_strip,isurf)) VHY = mesh_surf(2,idx_noder) & - mesh_surf(2,idx_nodel) VHZ = mesh_surf(3,idx_noder) @@ -1213,7 +1213,7 @@ subroutine makesurf_mesh(isurf) VHINGE(2,idx_strip,N) = VHY/VMOD VHINGE(3,idx_strip,N) = VHZ/VMOD - VREFL(idx_strip,N) = REFLD(ICL,idx_sec, isurf) + VREFL(idx_strip,N) = REFLD(ICL,idx_strip, isurf) IF(XHD .GE. 0.0) THEN PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD @@ -1230,8 +1230,8 @@ subroutine makesurf_mesh(isurf) ! Interpolate CD-CL polar defining data from input sections to strips DO idx_coef = 1, 6 CLCD(idx_coef,idx_strip) = (1.0-fc)* - & CLCDSEC(idx_coef,idx_sec,isurf) + - & fc*CLCDSEC(idx_coef,idx_sec+1,isurf) + & CLCDSEC(idx_coef,idx_strip,isurf) + + & fc*CLCDSEC(idx_coef,idx_strip+1,isurf) END DO ! If the min drag is zero flag the strip as no-viscous data LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) @@ -1253,8 +1253,8 @@ subroutine makesurf_mesh(isurf) NSURFS(idx_strip) = isurf ! Prepare for cross section interpolation - NSL = NASEC(idx_sec , isurf) - NSR = NASEC(idx_sec+1, isurf) + NSL = NASEC(idx_strip , isurf) + NSR = NASEC(idx_strip+1, isurf) ! CHORDC = CHORD(idx_strip) @@ -1266,9 +1266,10 @@ subroutine makesurf_mesh(isurf) ! between two secions is equal. ! After reaching out to Hal Youngren it is determined that it is ! best to just interpolate claf straight up for now -! clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL -! & + FC *(CHORDR/CHORD(idx_strip))*CLAFR - clafc = (1.-fc)*clafl + fc*clafr + ! UPDATE: Funny story. this is now valid now that we interpolate over the strip + clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL + & + FC *(CHORDR/CHORD(idx_strip))*CLAFR + ! clafc = (1.-fc)*clafl + fc*clafr ! loop over vorticies for the strip do idx_x = 1, nvc(isurf) @@ -1440,30 +1441,32 @@ subroutine makesurf_mesh(isurf) ! Set the camber slopes for the panel ! Camber slope at control point - CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), + CALL AKIMA(XASEC(1,idx_strip, isurf),SASEC(1,idx_strip, isurf), & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), + CALL AKIMA(XASEC(1,idx_strip+1,isurf),SASEC(1,idx_strip+1,isurf), & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) ! Interpolate this as is per Hal Youngren (for now) - SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER -! SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL -! & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + ! SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER + ! UPDATE THIS IS VALID AGAIN + SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER ! Camber slope at vortex mid-point - CALL AKIMA(XASEC(1,idx_sec, isurf),SASEC(1,idx_sec, isurf), + CALL AKIMA(XASEC(1,idx_strip, isurf),SASEC(1,idx_strip, isurf), & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,idx_sec+1,isurf),SASEC(1,idx_sec+1,isurf), + CALL AKIMA(XASEC(1,idx_strip+1,isurf),SASEC(1,idx_strip+1,isurf), & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) ! Interpolate this as is per Hal Youngren (for now) - SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER -! SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL -! & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + ! SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER + ! UPDATE THIS IS VALID AGAIN + SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER ! Associate the panel with it's strip's chord and component CHORDV(idx_vor) = CHORD(idx_strip) @@ -1512,17 +1515,17 @@ subroutine makesurf_mesh(isurf) ! & - RLE2(1,idx_strip))/CHORD2(idx_strip) ! Interpolate cross section on left side - CALL AKIMA( XLASEC(1,idx_sec,isurf), ZLASEC(1,idx_sec,isurf), + CALL AKIMA( XLASEC(1,idx_strip,isurf), ZLASEC(1,idx_strip,isurf), & NSL,xptxind1, ZL_L, DSDX ) - CALL AKIMA( XUASEC(1,idx_sec,isurf), ZUASEC(1,idx_sec,isurf), + CALL AKIMA( XUASEC(1,idx_strip,isurf), ZUASEC(1,idx_strip,isurf), & NSL,xptxind1, ZU_L, DSDX ) ! Interpolate cross section on right side - CALL AKIMA( XLASEC(1,idx_sec+1,isurf),ZLASEC(1,idx_sec+1,isurf), - & NSR, xptxind1, ZL_R, DSDX) + CALL AKIMA( XLASEC(1,idx_strip+1,isurf), + & ZLASEC(1,idx_strip+1,isurf),NSR, xptxind1, ZL_R, DSDX) - CALL AKIMA( XUASEC(1,idx_sec+1,isurf),ZUASEC(1,idx_sec+1,isurf), - & NSR, xptxind1, ZU_R, DSDX) + CALL AKIMA( XUASEC(1,idx_strip+1,isurf), + & ZUASEC(1,idx_strip+1,isurf),NSR, xptxind1, ZU_R, DSDX) ! Compute the left aft node of panel @@ -2183,7 +2186,7 @@ SUBROUTINE ENCALC C REAL EP(3), EQ(3), ES(3), EB(3), EC(3), ECXB(3) REAL EC_G(3,NDMAX), ECXB_G(3) - real(kind=avl_real) :: dchstrip, DXT, DYT, DZT + real(kind=avl_real) :: dchstrip, DXT, DYT, DZT, ec_msh(3) C C...Calculate the normal vector at control points and bound vortex midpoints C @@ -2337,28 +2340,63 @@ SUBROUTINE ENCALC ! from both the geometry itself and the incidence modification ! from the AVL AINC and camber slope variables - ! To avoid storing uncessary info in the common block ! Get the geometric chordwise vector using RVMSH and RCMSH which should ! be located in the same plane given that each individual panel is a ! plane - - ! Note that like in AVL the sin of the incidence is projected - ! to the strip's normal in the YZ plane (Treffz plane) - ! which is ES(2) and ES(3) computed earlier - EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) - EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) - EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) + + EMAG = SQRT((RCMSH(1,I)-RVMSH(1,I))**2 + & + (RCMSH(2,I)-RVMSH(2,I))**2 + & + (RCMSH(3,I)-RVMSH(3,I))**2) + ec_msh(1) = (RCMSH(1,I)-RVMSH(1,I))/EMAG + ec_msh(2) = (RCMSH(2,I)-RVMSH(2,I))/EMAG + ec_msh(3) = (RCMSH(3,I)-RVMSH(3,I))/EMAG + + ! Now we have to rotate this vector by the incidence contribution from AINC and CAMBER + ! However, this rotation needs to be done about the local y-axis of the wing + ! Earlier we computed ES the normal vector of the strip projected to the Trefftz plane + ! The axis we need to rotate about is the one purpendicular to this ES. + ! As a result all panel normals in a given strip will be rotated about the same axis defined by the that strip + ! The components of the rotation axis are obtained from ES as follows + ! rot_axis(1) = 0 + ! rot_axis(2) = -ES(3) + ! rot_axis(3) = ES(2) + ! We can then multiply ec_msh by the rotation matrix for a rotation about an arbitrary axis + ! see https://pubs.aip.org/aapt/ajp/article/44/1/63/1050167/Formalism-for-the-rotation-matrix-of-rotations + ! Note that standard AVL also does this exact same thing but since they always rotate the vector [1,0,0] + ! the result collapses into the ridiculously simple expression for EC that you see in the other branch + + EC(1) = COSC*ec_msh(1) + ES(2)*SINC*ec_msh(2) + & + ES(3)*SINC*ec_msh(3) + EC(2) = -ES(2)*SINC + ((ES(3)**2)*(1-COSC)+COSC)*ec_msh(2) + & - (ES(2)*ES(3)*(1-COSC))*ec_msh(3) + EC(3) = -ES(3)*SINC*ec_msh(1) - + & (ES(2)*ES(3)*(1-COSC))*ec_msh(2) + + & ((ES(2)**2)*(1-COSC) + COSC)*ec_msh(3) else EC(1) = COSC EC(2) = -SINC*ES(2) EC(3) = -SINC*ES(3) - ! EC = rotation of strip normal vector? or along chord? end if + DO N = 1, NDESIGN + ! The derivative here also changes if we use a custom mesh + ! Note the derivative is only wrt to AVL incidence vars + ! as those are the vars AVL DVs can support + if (lsurfmsh(nsurfs(J))) then + EC(1) = -SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) + & + ES(3)*COSC*ec_msh(3) + EC(2) = -ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC)*ec_msh(2) + & - (ES(2)*ES(3)*(1+SINC))*ec_msh(3) + EC(3) = -ES(3)*COSC*ec_msh(1) - + & (ES(2)*ES(3)*(1+SINC))*ec_msh(2) + + & ((ES(2)**2)*(1+SINC) - SINC)*ec_msh(3) + + else EC_G(1,N) = -SINC *AINC_G(J,N) EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) + end if ENDDO C C...Normal vector is perpendicular to camberline vector and to the bound leg @@ -2404,9 +2442,16 @@ SUBROUTINE ENCALC COSC = COS(ANG) if (lsurfmsh(nsurfs(J))) then ! direct mesh assignment branch - EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) - EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) - EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) + ! see explanation in section above for control point normals + ! ec_msh was already computed in that section + EC(1) = COSC*ec_msh(1) + ES(2)*SINC*ec_msh(2) + & + ES(3)*SINC*ec_msh(3) + EC(2) = -ES(2)*SINC + ((ES(3)**2)*(1-COSC)+COSC)*ec_msh(2) + & - (ES(2)*ES(3)*(1-COSC))*ec_msh(3) + EC(3) = -ES(3)*SINC*ec_msh(1) - + & (ES(2)*ES(3)*(1-COSC))*ec_msh(2) + + & ((ES(2)**2)*(1-COSC) + COSC)*ec_msh(3) + else EC(1) = COSC EC(2) = -SINC*ES(2) @@ -2414,9 +2459,21 @@ SUBROUTINE ENCALC end if DO N = 1, NDESIGN + if (lsurfmsh(nsurfs(J))) then + ! Direct mesh assignment branch + EC(1) = -SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) + & + ES(3)*COSC*ec_msh(3) + EC(2) = -ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC)*ec_msh(2) + & - (ES(2)*ES(3)*(1+SINC))*ec_msh(3) + EC(3) = -ES(3)*COSC*ec_msh(1) - + & (ES(2)*ES(3)*(1+SINC))*ec_msh(2) + + & ((ES(2)**2)*(1+SINC) - SINC)*ec_msh(3) + + else EC_G(1,N) = -SINC *AINC_G(J,N) EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) + end if ENDDO C C...Normal vector is perpendicular to camberline vector and to the bound leg From b7b5020ef1c1d9960bd6cdc2f9be8558e3b6f66c Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 3 Feb 2026 00:12:28 -0500 Subject: [PATCH 27/49] Reworked Mesh implementation. Ready for initial review --- optvl/optvl_class.py | 68 ++-- optvl/utils/check_surface_dict.py | 47 +-- src/amake.f | 595 +++--------------------------- src/f2py/libavl.pyf | 34 -- tests/test_input_dict.py | 31 +- 5 files changed, 87 insertions(+), 688 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 56dd713..da16866 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -588,7 +588,7 @@ def get_types_from_blk(common_blk): return (bool, int,np.int32) else: raise ValueError(f'type not able to be infered from common block {common_blk}') - + def check_type(key, avl_vars, given_val): """Checks the type for a given AVL Fortran Common Block var against a given value @@ -635,7 +635,7 @@ def check_type(key, avl_vars, given_val): optional_header_defaults = { "CDp": 0.0 } - + for key, avl_vars in self.header_var_to_fort_var.items(): if key not in input_dict: @@ -706,12 +706,8 @@ def check_type(key, avl_vars, given_val): surf_dict = input_dict["surfaces"][surf_name] - - # MOVED TO PRECHECK ROUTINE - # For meshes set the number of "sections" to the number of strips in the mesh so that the slice maps are setup correctly - # if "mesh" in surf_dict.keys(): - # num_secs = surf_dict["mesh"].shape[1] - 1 - # else: + # For meshes set the number of "sections" to the number of strips in the mesh so that the slice maps are setup correctly. + # This is automatically done by the pre-check routine num_secs = surf_dict["num_sections"] # Check how many strip/sections we have defined so far and that it doesn't exceed NSMAX @@ -810,13 +806,13 @@ def check_type(key, avl_vars, given_val): # determine what method of airfoil definition we are using # check to make sure we don't have multiple airfoil definitions used for this surface airfoil_spec_keys = {"naca", "airfoils", "afiles", "xasec"} & surf_dict.keys() - + if len(airfoil_spec_keys) > 1: raise KeyError(f'OptVL can only have one method of specifing airfoil geometry per surface, found {airfoil_spec_keys} in surface {surf_name}') - + xfminmax_arr = surf_dict.get("xfminmax", np.array([0.0, 1.0]*num_secs)) num_pts = min(50, self.IBX) - + # setup for manually specifying coordinates if "xasec" in surf_dict.keys(): warnings.warn( @@ -835,32 +831,32 @@ def check_type(key, avl_vars, given_val): # Load the Airfoil Section into AVL for j in range(num_secs): xfminmax = xfminmax_arr[j] - + # Manually Specify Coordiantes (no camberline verification, only use if you know what you're doing) if "xasec" in surf_dict.keys(): self.set_avl_fort_arr("SURF_GEOM_I", "NASEC", nasec_list[j], slicer=(idx_surf, j)) - + # TODO-JLA: a user should not have to spcify XLASEC, XUASEC, ZLASEC, ZUASEC # since these can be calculated from the other inputs - + for key in self.surf_section_geom_to_fort_var[surf_name]: avl_vars_secs = self.surf_section_geom_to_fort_var[surf_name][key] avl_vars = (avl_vars_secs[0], avl_vars_secs[1], avl_vars_secs[2][j]) - - + + if key not in surf_dict: raise ValueError(f"Key `{key}` not found in surface dictionary, `{surf_name}`, but is required when manually specifing airfoil coordinates") - + val = surf_dict[key][j] - - check_type(key, avl_vars, val) + + check_type(key, avl_vars, val) self.set_avl_fort_arr(avl_vars[0], avl_vars[1], val, slicer=avl_vars[2]) - + # 4 digit NACA airfoil specification elif "naca" in surf_dict.keys(): if (xfminmax[0] > 0.01) or (xfminmax[1] < 0.99): self.set_avl_fort_arr("SURF_L", "LRANGE", True, slicer=idx_surf) - + # Store this stuff so we can read it later self.avl.CASE_C.NACA[j, idx_surf] = surf_dict["naca"][j] self.avl.SURF_GEOM_R.XFMIN_R[j, idx_surf] = xfminmax[0] @@ -892,7 +888,7 @@ def check_type(key, avl_vars, given_val): self.set_avl_fort_arr("SURF_GEOM_R", "ZLASEC", np.array([0.0, 0.0]), slicer=slicer_airfoil_flat) self.set_avl_fort_arr("SURF_GEOM_R", "ZUASEC", np.array([0.0, 0.0]), slicer=slicer_airfoil_flat) self.set_avl_fort_arr("SURF_GEOM_R", "CASEC", np.array([0.0, 0.0]), slicer=slicer_airfoil_flat) - + # --- setup control variables for each section --- # Load control surfaces if "icontd" in surf_dict.keys(): @@ -949,14 +945,9 @@ def check_type(key, avl_vars, given_val): print(f"Building surface: {surf_name}") # Load the mesh and make if one is specified otherwise just make if "mesh" in surf_dict.keys(): - # Check if we have to define the sections for the user - if "iptloc" not in surf_dict.keys(): - surf_dict["iptloc"] = np.zeros(surf_dict["num_sections"],dtype=np.int32) - self.avl.adjust_mesh_spacing(idx_surf+1,surf_dict["mesh"].transpose((2, 0, 1)),surf_dict["iptloc"]) - surf_dict["iptloc"] = surf_dict["iptloc"] - 1 if "flatten mesh" not in surf_dict.keys(): surf_dict["flatten mesh"] = True - self.set_mesh(idx_surf, surf_dict["mesh"],surf_dict["iptloc"],flatten=surf_dict["flatten mesh"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering + self.set_mesh(idx_surf, surf_dict["mesh"],flatten=surf_dict["flatten mesh"],update_nvs=True,update_nvc=True) # set_mesh handles the Fortran indexing and ordering self.avl.makesurf_mesh(idx_surf + 1) #+1 for Fortran indexing else: self.avl.makesurf(idx_surf + 1) # +1 to convert to 1 based indexing @@ -1047,7 +1038,7 @@ def check_type(key, avl_vars, given_val): # Keep python data consistent with Fortran idx_body += 1 - + idx_body += 1 @@ -1076,17 +1067,12 @@ def check_type(key, avl_vars, given_val): # Tell AVL that geometry exists now and is ready for analysis self.avl.CASE_L.LGEO = True - def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, flatten:bool=True, update_nvs: bool=False, update_nvc: bool=False): - """Sets a mesh directly into OptVL. Requires an iptloc vector to define the indices where the sections are defined. - This is required for many of AVL's features like control surfaces to work properly. OptVL's input routine has multiple - ways of automatically computing this vector. Alternatively, calling the adjust_mesh_spacing subroutine in the Fortran layer - can automatically compute the iptloc vector for a given mesh and number of sections. NOTE: the iptloc input is not differentiated. - Additionally, the length of iptloc cannot change (i.e the number sections cannot change for a surface that's already loaded). + def set_mesh(self, idx_surf: int, mesh: np.ndarray, flatten:bool=True, update_nvs: bool=False, update_nvc: bool=False): + """Sets a mesh directly into OptVL. Args: idx_surf (int): the surface to apply the mesh to mesh (np.ndarray): XYZ mesh array (nx,ny,3) - iptloc (np.ndarray): Vector containing the spanwise indicies where each section is defined (num_sections,) flatten (bool): Should OptVL flatten the mesh when placing vorticies and control points update_nvs (bool): Should OptVL update the number of spanwise elements for the given mesh update_nvc (bool): Should OptVL update the number of chordwise elements for the given mesh @@ -1094,9 +1080,6 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, flatten: nx = copy.deepcopy(mesh.shape[0]) ny = copy.deepcopy(mesh.shape[1]) - if len(iptloc) > self.NSMAX: - raise RuntimeError("Length of iptloc cannot exceed NSMAX. Raise NSMAX") - if update_nvs: self.avl.SURF_GEOM_I.NVS[idx_surf] = ny-1 @@ -1108,13 +1091,6 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, iptloc: np.ndarray, flatten: else: self.avl.SURF_MESH_L.LMESHFLAT[idx_surf] = False - # Only add +1 for Fortran indexing if we are not explictly telling the routine to use - # nspans by passing in all zeros - if not (iptloc == 0).all(): - iptloc += 1 - # set iptloc - self.set_avl_fort_arr("SURF_MESH_I","IPTSEC",iptloc,slicer=(idx_surf,slice(None,len(iptloc)))) - # Compute and set the mesh starting index if idx_surf != 0: self.mesh_idx_first[idx_surf] = self.mesh_idx_first[idx_surf-1] + 3*(self.avl.SURF_GEOM_I.NVS[idx_surf-1]+1)*(self.avl.SURF_GEOM_I.NVC[idx_surf-1]+1) diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index c18c92f..5e4d65f 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -11,8 +11,6 @@ # External Python modules # ============================================================================= import numpy as np -import pdb - # ============================================================================= # Extension modules @@ -131,7 +129,6 @@ def pre_check_input_dict(input_dict: dict): "use surface spacing", # surface spacing set under the surface heeading (known as LSURFSPACING in AVL) # Geometery: Mesh "mesh", - "iptloc", "flatten_mesh", # Control Surfaces "control_assignments", @@ -246,40 +243,7 @@ def pre_check_input_dict(input_dict: dict): if len(input_dict["surfaces"]) > 0: for surface in input_dict["surfaces"].keys(): - # Check if we are directly providing a mesh - # if "mesh" in input_dict["surfaces"][surface].keys(): - # # Check if sections are specified - # if "num_sections" in input_dict["surfaces"][surface].keys(): - # # Check if the section indices are provided - # if "iptloc" in input_dict["surfaces"][surface].keys(): - # # If they are make sure we provide one for every section - # if len(input_dict["surfaces"][surface]["iptloc"]) != input_dict["surfaces"][surface]["num_sections"]: - # raise ValueError("iptloc vector length does not match num_sections") - # # Check if the user provided nspans instead - # elif "nspans" in input_dict["surfaces"][surface].keys(): - # # setting iptloc to 0 is how we tell the Fortran layer to use nspans - # input_dict["surfaces"][surface]["iptloc"] = np.zeros(input_dict["surfaces"][surface]["num_sections"]) - # # The OptVL class will have to call the fudging routine to try and auto cut the mesh into sections - # else: - # warnings.warn( - # "Mesh provided for surface dict `{}` for {} sections but locations not defined.\n OptVL will automatically define section locations as close to equally as possible.".format( - # surface, input_dict["surfaces"][surface]["num_sections"] - # ), - # category=RuntimeWarning, - # stacklevel=2, - # ) - # else: - # # Assume we have two sections at the ends of mesh and inform the user - # warnings.warn( - # "Mesh provided for surface dict `{}` but no sections provided.\n Assuming 2 sections at tips.".format( - # surface - # ), - # category=RuntimeWarning, - # stacklevel=2, - # ) - # input_dict["surfaces"][surface]["iptloc"] = np.array([0,input_dict["surfaces"][surface]["mesh"].shape[1]-1],dtype=np.int32) - # input_dict["surfaces"][surface]["num_sections"] = 2 - + # Check if we are directly providing a mesh and set the strips as "sections" so that the maps setup correctly if "mesh" in input_dict["surfaces"][surface].keys(): # First check if the mesh is a valid numpy array shape if len(input_dict["surfaces"][surface]["mesh"].shape) != 3: @@ -403,15 +367,6 @@ def pre_check_input_dict(input_dict: dict): raise ValueError( f"Key {key} is of dimension {input_dict['surfaces'][surface][key].ndim}, expected 1!" ) - - - - # if ( - # input_dict["surfaces"][surface][key].shape[0] - # != input_dict["surfaces"][surface]["num_sections"] - # ): - # # Expand scalars to t - # raise ValueError(f"Key {key} does not have entries corresponding to each section!s") # Check for keys not implemented if key not in keys_implemented_surface: diff --git a/src/amake.f b/src/amake.f index 295d184..fbaaed3 100644 --- a/src/amake.f +++ b/src/amake.f @@ -640,156 +640,6 @@ SUBROUTINE MAKESURF(ISURF) RETURN END ! MAKESURF - subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, - & iptloc, nsecsurf) - ! This routine is a modified standalone version of the "fudging" - ! operation in makesurf. The main purpose is to deal with cases - ! where the user provide a mesh and does not specify the indicies - ! where the sections are nor do they include the number of spanwise - ! elements associated with each section. This routine is intended - ! to be run as a preprocessing step to compute iptloc and the fudged mesh - ! as once we have iptloc makesurf_mesh will know how to handle the sections. - INCLUDE 'AVL.INC' - ! input/output - integer nx, ny, nsecsurf, isurf - integer isec, ipt, ipt1, ipt2, idx_sec, idx_pt - integer iptloc(nsecsurf) - real mesh(3,nx,ny) - - ! working variables - integer niptloc - real ylen(nsecsurf), yzlen(nsecsurf) - real yptloc, yptdel, yp1, yp2, dy, dz, y_mesh, dy_mesh - - ! check that iptloc is the correct size - if (nsecsurf /= NSEC(isurf)) then - write(*,'(A,I2,A,I2)') 'given size of iptloc:',nsecsurf, - & ' does not match NSEC(isurf):', NSEC(isurf) - endif - - - ! Check if the mesh can be adjusted - if (ny < nsecsurf) then - print *, "*** Not enought spanwise nodes to split the mesh" - stop - end if - - ! Unlike the standard fudging routine we have no idea where - ! each section's leading edge is located ahead of time - ! Instead we have to make an initial guess by cutting up - ! the mesh into equal pieces spanwise assuming the wing is flat. - ! We only need to do this is there isn't already a guess for iptloc - - if (iptloc(1) .eq. 0) then - ! compute mesh y length - y_mesh = mesh(2,1,ny) - mesh(2,1,1) - dy_mesh = y_mesh/(NSEC(isurf)-1) - write(*,*) 'y_mesh', y_mesh - write(*,*) 'dy_mesh', dy_mesh - - ! Chop up into equal y length pieces - ylen(1) = 0. - do idx_sec = 2,NSEC(isurf) - ylen(idx_sec) = ylen(idx_sec-1) + dy_mesh - end do - - ! Find node nearest each section - do idx_sec = 2, NSEC(isurf)-1 - yptloc = 1.0E9 - iptloc(idx_sec) = 1 - do idx_pt = 1, ny - yptdel = abs(mesh(2,1,1)+ ylen(idx_sec) - mesh(2,1,idx_pt)) - if(yptdel .LT. yptloc) then - yptloc = yptdel - iptloc(idx_sec) = idx_pt - endif - enddo - enddo - iptloc(1) = 1 - iptloc(NSEC(isurf)) = ny - end if - - ! NOTE-SB: I don't think we need this - ! I originally included it to be more consistent with AVL - ! The prior routine only considers the y distance while - ! AVL considers y and z. However, the above routine appears - ! to work fine on its own and running this after appears to - ! cause issues. - - ! Now compute yz arc length using the computed section indicies -! yzlen(1) = 0. -! do idx_sec = 2, NSEC(isurf) -! dy = mesh(2,1,iptloc(idx_sec)) - mesh(2,1 -! & , (iptloc(idx_sec)-1)) -! dz = mesh(3,1,iptloc(idx_sec)) - mesh(3,1 -! & , (iptloc(idx_sec)-1)) -! yzlen(idx_sec) = yzlen(idx_sec-1) + sqrt(dy*dy + dz*dz) -! end do - -! ! Now do the AVL fudging routine to ensure the sections don't split panels - -! ! Find node nearest each section -! do isec = 2, NSEC(isurf)-1 -! yptloc = 1.0E9 -! iptloc(isec) = 1 -! do ipt = 1, ny -! yptdel = abs(yzlen(isec) - mesh(2,1,ipt)) -! if(yptdel .LT. yptloc) then -! yptloc = yptdel -! iptloc(ISEC) = ipt -! endif -! enddo -! enddo -! iptloc(1) = 1 -! iptloc(NSEC(ISURF)) = ny - -! print *, "Final iptloc", iptloc - - ! fudge spacing array to make nodes match up exactly with interior sections - do isec = 2, NSEC(isurf)-1 - ! Throws an error in the case where the same node is the closest node - ! to two consecutive sections - ipt1 = iptloc(isec-1) - ipt2 = iptloc(isec ) - if(ipt1.EQ.ipt2) then - CALL STRIP(STITLE(isurf),NST) - WRITE(*,7000) isec, STITLE(isurf)(1:NST) - STOP - end if - - ! fudge spacing to this section so that nodes match up exactly with section - ypt1 = mesh(2,1,ipt1) - yscale = (yzlen(isec)-yzlen(isec-1)) / (mesh(2,1,ipt2) - & -ypt1) - do ipt = ipt1, ipt2-1 - mesh(2,1,ipt) = yzlen(isec-1) + yscale*(mesh(2,1,ipt)-ypt1) - end do - - ! check for unique spacing node for next section, if not we need more nodes - ipt1 = iptloc(isec ) - ipt2 = iptloc(isec+1) - if(ipt1.EQ.ipt2) then - CALL STRIP(STITLE(isurf),NST) - WRITE(*,7000) isec, STITLE(isurf)(1:NST) - STOP - endif - - ! fudge spacing to this section so that nodes match up exactly with section - ypt1 = mesh(2,1,ipt1) - ypt2 = mesh(2,1,ipt2) - yscale = (ypt2-yzlen(isec)) / (ypt2-ypt1) - do ipt = ipt1, ipt2-1 - mesh(2,1,ipt) = yzlen(isec) + yscale*(mesh(2,1,ipt)-ypt1) - enddo - - 7000 format( - & /' *** Cannot adjust spanwise spacing at section', I3, - & ', on surface ', A - & /' *** Insufficient number of spanwise vortices to work with') - enddo - - end subroutine adjust_mesh_spacing - integer function flatidx(idx_x, idx_y, idx_surf) include 'AVL.INC' ! store MFRST and NVC in the common block @@ -834,26 +684,6 @@ subroutine makesurf_mesh(isurf) nx = NVC(isurf) + 1 ny = NVS(isurf) + 1 - ! If the user doesn't input a index vector telling us at what - ! spanwise index each section is located they will have to have - ! provided nspans otherwise they will have to go back and provide - ! iptloc or run adjust_mesh_spacing as a preprocessing step to get - ! a iptloc vector. - if (IPTSEC(1,isurf) .eq. 0) then - ! if NSPANS is given then use it - if (NSPANS(1,isurf) .ne. 0) then - IPTSEC(1,isurf) = 1 - do idx_sec = 2,NSEC(isurf) - IPTSEC(idx_sec,isurf) = IPTSEC(idx_sec-1,isurf) + - & NSPANS(idx_sec-1,isurf) - end do - else - print *, '* Provide NSPANS or IPTSEC. (Hint: Run adjust_mesh_& - & spacing)' - stop - end if - end if - ! Check MFRST if (MFRST(isurf) .eq. 0) then print *, "* Provide the index where the mesh begins for surface", @@ -863,12 +693,7 @@ subroutine makesurf_mesh(isurf) ! Get the mesh for this surface from the the common block mesh_surf = MSHBLK(:,MFRST(isurf):MFRST(isurf)+(nx*ny)-1) - ! Perform input checks from makesurf - - IF(NSEC(ISURF).LT.2) THEN - WRITE(*,*) '*** Need at least 2 sections per surface.' - STOP - ENDIF + ! Perform input checks from makesurf (section check removed) IF(NVC(ISURF).GT.KCMAX) THEN WRITE(*,*) '* makesurf_mesh: Array overflow. Increase KCMAX to', @@ -909,18 +734,21 @@ subroutine makesurf_mesh(isurf) idx_strip = JFRST(ISURF) ! Bypass the entire spanwise node generation routine and go straight to store counters - ! Index of first section in surface + ! Index of first strip in surface + ! This is normally used to store the index of each section in AVL + ! but since we use strips now each is effectively just a section + ! We assign this variable accordingly so as not to break anything else IF (ISURF .EQ. 1) THEN ICNTFRST(ISURF) = 1 ELSE ICNTFRST(ISURF) = ICNTFRST(ISURF-1) + NCNTSEC(ISURF-1) ENDIF - ! Number of sections in surface + ! Number of strips/sections in surface NCNTSEC(ISURF) = NSEC(ISURF) - ! Store the spanwise index of each section in each surface + ! Store the spanwise index of each strip in each surface DO ISEC = 1, NSEC(ISURF) II = ICNTFRST(ISURF) + (ISEC-1) - ICNTSEC(II) = idx_strip !IPTSEC(ISEC,isurf) + ICNTSEC(II) = idx_strip ENDDO @@ -954,24 +782,21 @@ subroutine makesurf_mesh(isurf) STOP ENDIF - ! New Loop over all strips in surface + ! Instead of looping over sections just loop over all strips in the surface do ispan = 1,ny-1 - ! Loop over sections - ! do idx_sec = 1, NSEC(isurf)-1 - - ! Set reference information for the section - ! iptl = IPTSEC(idx_sec,isurf) - ! iptr = IPTSEC(idx_sec+1,isurf) + ! Set reference information for the strip + ! This code was used in the original to loop over strips in a section. + ! We will just reuse the variables here iptl = idx_strip - iptr = idx_strip + 1 - ! nspan = iptr - iptl - NJ(isurf) = NJ(isurf) + 1 ! nspan + iptr = idx_strip + 1 + NJ(isurf) = NJ(isurf) + 1 - ! We need to compute the chord and claf values at the left and right edge of the section - ! These will be needed by AVL for control surface setup and control point placement + ! We need to compute the chord and claf values at the left and right edge of the strip + ! This code was used in the original to interpolate over sections. + ! We will just reuse here to interpolate over a strip which is trivial but avoids pointless code rewrites. idx_node = flatidx(1,iptl,isurf) idx_node_nx = flatidx(nx,iptl,isurf) CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 @@ -983,20 +808,7 @@ subroutine makesurf_mesh(isurf) CLAFL = CLAF(idx_strip, isurf) CLAFR = CLAF(idx_strip+1,isurf) - ! Compute the incidence angle at the section end points - ! We will need this later to iterpolate chord projections - ! SAB Note: This type of interpolation assumes the section - ! is linear. However, the twist angles it produces can be applied - ! to an arbitrary mesh. The user just needs to be aware of what they are - ! applying here. - ! Analogy: imagine that we create a trapazoidal section - ! that matches up with the root and tip chords of your arbitrary wing section - ! The trapzoid can encompass the wing section or parts of the section can be - ! protruding out side the trapazoid. It doesn't matter. Now we twist the trapazoid - ! so that the angles at the root and tip match what is specified at the sections in - ! AINCS. However, when we twist we make sure to keep the leading and trailing edges - ! linear (straight line along the LE and TE). The angles at each strip required to - ! do are what gets applied to the normal vector at each strip. + ! Linearly interpolate the incidence projections over the STRIP AINCL = AINCS(idx_strip,isurf)*DTR + ADDINC(isurf)*DTR AINCR = AINCS(idx_strip+1,isurf)*DTR + ADDINC(isurf)*DTR CHSINL = CHORDL*SIN(AINCL) @@ -1005,7 +817,7 @@ subroutine makesurf_mesh(isurf) CHCOSR = CHORDR*COS(AINCR) ! We need to determine which controls belong to this section - ! Bring over the routine for this from makesurf + ! Bring over the routine for this from makesurf but do it for each strip now DO N = 1, NCONTROL ISCONL(N) = 0 ISCONR(N) = 0 @@ -1017,9 +829,9 @@ subroutine makesurf_mesh(isurf) ENDDO ENDDO - ! We need to determine which dvs belong to this section + ! We need to determine which dvs belong to this strip ! and setup the chord projection gains - ! Bring over the routine for this from makesurf + ! Bring over the routine for this from makesurf but setup for strips DO N = 1, NDESIGN CHSINL_G(N) = 0. CHSINR_G(N) = 0. @@ -1046,9 +858,6 @@ subroutine makesurf_mesh(isurf) ! Note these computations assume the mesh is not necessarily planar ! ultimately if/when we flatten the mesh into a planar one we will want ! to use the leading edge positions and chords from the original input mesh - - ! Loop over strips in section - ! do ispan = 1,nspan idx_y = idx_strip - JFRST(isurf) + 1 ! Strip left side @@ -1108,27 +917,32 @@ subroutine makesurf_mesh(isurf) ! In AVL the AINCS are not interpolated. The chord projections are ! So we have to replicate this effect. - ! LINEAR interpolation over the section: left, right, and midpoint + ! LINEAR interpolation over the strip: left, right, and midpoint idx_nodel = flatidx(1,iptl,isurf) idx_noder = flatidx(1,iptr,isurf) - f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ - & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) - f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ - & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) - fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) - & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) - & -mesh_surf(2,idx_nodel)) +! f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ +! & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) +! f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ +! & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) +! fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) +! & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) +! & -mesh_surf(2,idx_nodel)) + + ! the above expressions will always evaluate to the following for individual strips + f1 = 0.0 + f2 = 1.0 + fc = 0.5 ! Strip left side incidence - CHSIN = CHSINL + f1*(CHSINR-CHSINL) - CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) - AINC1(idx_strip) = ATAN2(CHSIN,CHCOS) + ! CHSIN = CHSINL + f1*(CHSINR-CHSINL) + ! CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) + AINC1(idx_strip) = ATAN2(CHSINL,CHCOSL) ! Strip right side incidence - CHSIN = CHSINL + f2*(CHSINR-CHSINL) - CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) - AINC2(idx_strip) = ATAN2(CHSIN,CHCOS) + ! CHSIN = CHSINL + f2*(CHSINR-CHSINL) + ! CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) + AINC2(idx_strip) = ATAN2(CHSINR,CHCOSR) ! Strip mid-point incidence CHSIN = CHSINL + fc*(CHSINR-CHSINL) @@ -1144,8 +958,8 @@ subroutine makesurf_mesh(isurf) & / (CHSIN**2 + CHCOS**2) ENDDO - ! We have to now setup any control surfaces we defined for this section - ! Bring over the routine for this from makesurf + ! We have to now setup any control surfaces we defined for this strip + ! Bring over the routine for this from makesurf but modified for a strip DO N = 1, NCONTROL ICL = ISCONL(N) ICR = ISCONR(N) @@ -1227,7 +1041,7 @@ subroutine makesurf_mesh(isurf) ENDIF ENDDO - ! Interpolate CD-CL polar defining data from input sections to strips + ! Interpolate CD-CL polar defining data from input to strips DO idx_coef = 1, 6 CLCD(idx_coef,idx_strip) = (1.0-fc)* & CLCDSEC(idx_coef,idx_strip,isurf) + @@ -1258,17 +1072,11 @@ subroutine makesurf_mesh(isurf) ! CHORDC = CHORD(idx_strip) - ! Interpolate claf over the section - ! SAB: In AVL this quantity is interpolated as a product with chord - ! We then divide by the chord at the strip to recover claf at the strip - ! This only works correctly for linear sections. For arbitrary sections - ! this can result in the claf varying across the span even when the claf - ! between two secions is equal. - ! After reaching out to Hal Youngren it is determined that it is - ! best to just interpolate claf straight up for now - ! UPDATE: Funny story. this is now valid now that we interpolate over the strip + + ! Funny story. this original line is now valid now that we interpolate over the strip clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL & + FC *(CHORDR/CHORD(idx_strip))*CLAFR + ! Suggestion from Hal Yougren for non linear sections: ! clafc = (1.-fc)*clafl + fc*clafr ! loop over vorticies for the strip @@ -1448,9 +1256,9 @@ subroutine makesurf_mesh(isurf) & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) - ! Interpolate this as is per Hal Youngren (for now) + ! Alternative for nonlinear sections per Hal Youngren ! SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER - ! UPDATE THIS IS VALID AGAIN + ! The original line is valid for interpolation over a strip SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL & + fc *(CHORDR/CHORD(idx_strip))*SLOPER @@ -1462,9 +1270,9 @@ subroutine makesurf_mesh(isurf) & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) - ! Interpolate this as is per Hal Youngren (for now) + ! Alternative for nonlinear sections per Hal Youngren ! SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER - ! UPDATE THIS IS VALID AGAIN + ! The original line is valid for interpolation over a strip SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL & + fc *(CHORDR/CHORD(idx_strip))*SLOPER @@ -1566,8 +1374,6 @@ subroutine makesurf_mesh(isurf) idx_strip = idx_strip + 1 end do ! End strip loop - ! end do ! End section loop - ! Compute the wetted area and cave from the true mesh sum = 0.0 wtot = 0.0 @@ -2566,304 +2372,3 @@ SUBROUTINE ENCALC C RETURN END ! ENCALC - - - - - -! SUBROUTINE ENCALCMSH -! C -! C...PURPOSE To calculate the normal vectors for the strips, -! C the horseshoe vortices, and the control points. -! C Assuming arbitrary point cloud mesh -! C Incorporates surface deflections. -! C -! C...INPUT NVOR Number of vortices -! C X1 Coordinates of endpoint #1 of the vortices -! C X2 Coordinates of endpoint #2 of the vortices -! C SLOPEV Slope at bound vortices -! C SLOPEC Slope at control points -! C NSTRIP Number of strips -! C IJFRST Index of first element in strip -! C NVSTRP No. of vortices in strip -! C AINC Angle of incidence of strip -! C LDES include design-variable deflections if TRUE -! C -! C...OUTPUT ENC(3) Normal vector at control point -! C ENV(3) Normal vector at bound vortices -! C ENSY, ENSZ Strip normal vector (ENSX=0) -! C LSTRIPOFF Non-used strip (T) (below z=ZSYM) -! C -! C...COMMENTS -! C -! INCLUDE 'AVL.INC' -! C -! REAL EP(3), EQ(3), ES(3), EB(3), EC(3), ECXB(3) -! REAL EC_G(3,NDMAX), ECXB_G(3) - -! real(kind=avl_real) :: dchstrip, DXT, DYT, DZT -! C -! C...Calculate the normal vector at control points and bound vortex midpoints -! C -! DO 10 J = 1, NSTRIP -! C -! C...Calculate normal vector for the strip (normal to X axis) -! ! we can't just interpolate this anymore given that -! ! the strip is no longer necessarily linear chordwise - -! ! We want the spanwise unit vector for the strip at the -! ! chordwise location specified by SAXFR (usually set to 0.25) -! ! Loop over all panels in the strip until we find the one that contains -! ! the SAXFR position in it's projected chord. Since the panels themselves are still linear -! ! we can just use the bound vortex unit vector of that panel as -! ! the spanwise unit vector of the strip at SAXFR - -! ! SAB: This is slow, find a better way to do this -! dchstrip = 0.0 -! searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) -! dchstrip = dchstrip+DXSTRPV(i) -! if (dchstrip .ge. CHORD(J)*SAXFR) then -! exit searchSAXFR -! end if -! end do searchSAXFR - -! ! print *, "I", I - -! ! compute the spanwise unit vector for Vperp def -! DXT = RV2MSH(1,I)-RV1MSH(1,I) -! DYT = RV2MSH(2,I)-RV1MSH(2,I) -! DZT = RV2MSH(3,I)-RV1MSH(3,I) -! XSREF(J) = RVMSH(1,I) -! YSREF(J) = RVMSH(2,I) -! ZSREF(J) = RVMSH(3,I) - -! ! print *, "DVT", DYT -! ! print *, "RV2(2,I)-RV1(2,I)", RV2(2,I)-RV1(2,I) -! ! print *, "RV2(2,I)", RV2(2,I) -! ! print *, "RV1(2,I)", RV1(2,I) -! ! print *, "NSTRIP", NSTRIP -! ! print *, "J", J -! ESS(1,J) = DXT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) -! ESS(2,J) = DYT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) -! ESS(3,J) = DZT/SQRT(DXT*DXT + DYT*DYT + DZT*DZT) - -! ! Treffz plane normals -! ENSY(J) = -DZT/SQRT(DYT*DYT + DZT*DZT) -! ENSZ(J) = DYT/SQRT(DYT*DYT + DZT*DZT) - -! ES(1) = 0. -! ES(2) = ENSY(J) -! ES(3) = ENSZ(J) -! C -! LSTRIPOFF(J) = .FALSE. -! C -! NV = NVSTRP(J) -! DO 105 II = 1, NV -! C -! I = IJFRST(J) + (II-1) -! C -! DO N = 1, NCONTROL -! ENV_D(1,I,N) = 0. -! ENV_D(2,I,N) = 0. -! ENV_D(3,I,N) = 0. -! ENC_D(1,I,N) = 0. -! ENC_D(2,I,N) = 0. -! ENC_D(3,I,N) = 0. -! ENDDO -! C -! DO N = 1, NDESIGN -! ENV_G(1,I,N) = 0. -! ENV_G(2,I,N) = 0. -! ENV_G(3,I,N) = 0. -! ENC_G(1,I,N) = 0. -! ENC_G(2,I,N) = 0. -! ENC_G(3,I,N) = 0. -! ENDDO -! C -! C...Define unit vector along bound leg -! DXB = RV2MSH(1,I)-RV1MSH(1,I) ! right h.v. pt - left h.v. pt -! DYB = RV2MSH(2,I)-RV1MSH(2,I) -! DZB = RV2MSH(3,I)-RV1MSH(3,I) -! EMAG = SQRT(DXB**2 + DYB**2 + DZB**2) -! EB(1) = DXB/EMAG -! EB(2) = DYB/EMAG -! EB(3) = DZB/EMAG -! C -! C...Define direction of normal vector at control point - -! ! First start by combining the contributions to the panel -! ! incidence from AVL incidence and camberline slope variables -! ! these are not actual geometric transformations of the mesh -! ! but rather further modifications to the chordwise vector that -! ! will get used to compute normals -! ANG = AINC(J) - ATAN(SLOPEC(I)) -! C--------- add design-variable contribution to angle -! DO N = 1, NDESIGN -! ANG = ANG + AINC_G(J,N)*DELDES(N) -! ENDDO -! C -! ! now we compute the chordwise panel vector -! ! note that panel's chordwise vector has contributions -! ! from both the geometry itself and the incidence modification -! ! from the AVL AINC and camber slope variables - -! ! To avoid storing uncessary info in the common block -! ! Get the geometric chordwise vector using RV and RC which should -! ! be located in the same plane given that each individual panel is a -! ! plane - -! ! Note that like in AVL the sin of the incidence is projected -! ! to the strip's normal in the YZ plane (Treffz plane) -! ! which is ES(2) and ES(3) computed earlier -! SINC = SIN(ANG) -! COSC = COS(ANG) -! EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) -! EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) -! EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) - -! DO N = 1, NDESIGN -! EC_G(1,N) = -SINC *AINC_G(J,N) -! EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) -! EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) -! ENDDO -! C -! C...Normal vector is perpendicular to camberline vector and to the bound leg -! CALL CROSS(EC,EB,ECXB) -! EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) -! IF(EMAG.NE.0.0) THEN -! ENC(1,I) = ECXB(1)/EMAG -! ENC(2,I) = ECXB(2)/EMAG -! ENC(3,I) = ECXB(3)/EMAG -! DO N = 1, NDESIGN -! CALL CROSS(EC_G(1,N),EB,ECXB_G) -! EMAG_G = ENC(1,I)*ECXB_G(1) -! & + ENC(2,I)*ECXB_G(2) -! & + ENC(3,I)*ECXB_G(3) -! ENC_G(1,I,N) = (ECXB_G(1) - ENC(1,I)*EMAG_G)/EMAG -! ENC_G(2,I,N) = (ECXB_G(2) - ENC(2,I)*EMAG_G)/EMAG -! ENC_G(3,I,N) = (ECXB_G(3) - ENC(3,I)*EMAG_G)/EMAG -! ENDDO -! ELSE -! ENC(1,I) = ES(1) -! ENC(2,I) = ES(2) -! ENC(3,I) = ES(3) -! ENDIF - -! C -! C -! C...Define direction of normal vector at vortex mid-point. - -! ! This section is identical to the normal vector at the control -! ! point. The only different is that the AVL camberline slope -! ! is taken at the bound vortex point rather than the control point -! ! the geometric contributions to the normal vector at both of these -! ! point is identical as the lie in the plane of the same panel. -! ANG = AINC(J) - ATAN(SLOPEV(I)) - -! C--------- add design-variable contribution to angle -! DO N = 1, NDESIGN -! ANG = ANG + AINC_G(J,N)*DELDES(N) -! ENDDO - -! C -! SINC = SIN(ANG) -! COSC = COS(ANG) -! EC(1) = COSC + (RCMSH(1,I)-RVMSH(1,I)) -! EC(2) = -SINC*ES(2) + (RCMSH(2,I)-RVMSH(2,I)) -! EC(3) = -SINC*ES(3) + (RCMSH(3,I)-RVMSH(3,I)) -! DO N = 1, NDESIGN -! EC_G(1,N) = -SINC *AINC_G(J,N) -! EC_G(2,N) = -COSC*ES(2)*AINC_G(J,N) -! EC_G(3,N) = -COSC*ES(3)*AINC_G(J,N) -! ENDDO -! C -! C...Normal vector is perpendicular to camberline vector and to the bound leg -! CALL CROSS(EC,EB,ECXB) -! EMAG = SQRT(ECXB(1)**2 + ECXB(2)**2 + ECXB(3)**2) -! IF(EMAG.NE.0.0) THEN -! ENV(1,I) = ECXB(1)/EMAG -! ENV(2,I) = ECXB(2)/EMAG -! ENV(3,I) = ECXB(3)/EMAG -! DO N = 1, NDESIGN -! CALL CROSS(EC_G(1,N),EB,ECXB_G) -! EMAG_G = ENC(1,I)*ECXB_G(1) -! & + ENC(2,I)*ECXB_G(2) -! & + ENC(3,I)*ECXB_G(3) -! ENV_G(1,I,N) = (ECXB_G(1) - ENV(1,I)*EMAG_G)/EMAG -! ENV_G(2,I,N) = (ECXB_G(2) - ENV(2,I)*EMAG_G)/EMAG -! ENV_G(3,I,N) = (ECXB_G(3) - ENV(3,I)*EMAG_G)/EMAG -! ENDDO -! ELSE -! ENV(1,I) = ES(1) -! ENV(2,I) = ES(2) -! ENV(3,I) = ES(3) -! ENDIF -! C -! C -! ccc write(*,*) i, dcontrol(i,1), dcontrol(i,2) -! C -! C======================================================= -! C-------- rotate normal vectors for control surface -! ! this is a pure rotation of the normal vector -! ! the geometric contribution from the mesh is already accounted for -! DO 100 N = 1, NCONTROL -! C -! C---------- skip everything if this element is unaffected by control variable N -! IF(DCONTROL(I,N).EQ.0.0) GO TO 100 -! C -! ANG = DTR*DCONTROL(I,N)*DELCON(N) -! ANG_DDC = DTR*DCONTROL(I,N) -! C -! COSD = COS(ANG) -! SIND = SIN(ANG) -! C -! C---------- EP = normal-vector component perpendicular to hinge line -! ENDOT = DOT(ENC(1,I),VHINGE(1,J,N)) -! EP(1) = ENC(1,I) - ENDOT*VHINGE(1,J,N) -! EP(2) = ENC(2,I) - ENDOT*VHINGE(2,J,N) -! EP(3) = ENC(3,I) - ENDOT*VHINGE(3,J,N) -! C---------- EQ = unit vector perpendicular to both EP and hinge line -! CALL CROSS(VHINGE(1,J,N),EP,EQ) -! C -! C---------- rotated vector would consist of sin,cos parts from EP and EQ, -! C- with hinge-parallel component ENDOT restored -! cc ENC(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) -! cc ENC(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) -! cc ENC(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) -! C -! C---------- linearize about zero deflection (COSD=1, SIND=0) -! ENC_D(1,I,N) = ENC_D(1,I,N) + EQ(1)*ANG_DDC -! ENC_D(2,I,N) = ENC_D(2,I,N) + EQ(2)*ANG_DDC -! ENC_D(3,I,N) = ENC_D(3,I,N) + EQ(3)*ANG_DDC -! C -! C -! C---------- repeat for ENV vector -! C -! C---------- EP = normal-vector component perpendicular to hinge line -! ENDOT = DOT(ENV(1,I),VHINGE(1,J,N)) -! EP(1) = ENV(1,I) - ENDOT*VHINGE(1,J,N) -! EP(2) = ENV(2,I) - ENDOT*VHINGE(2,J,N) -! EP(3) = ENV(3,I) - ENDOT*VHINGE(3,J,N) -! C---------- EQ = unit vector perpendicular to both EP and hinge line -! CALL CROSS(VHINGE(1,J,N),EP,EQ) -! C -! C---------- rotated vector would consist of sin,cos parts from EP and EQ, -! C- with hinge-parallel component ENDOT restored -! cc ENV(1,I) = EP(1)*COSD + EQ(1)*SIND + ENDOT*VHINGE(1,J,N) -! cc ENV(2,I) = EP(2)*COSD + EQ(2)*SIND + ENDOT*VHINGE(2,J,N) -! cc ENV(3,I) = EP(3)*COSD + EQ(3)*SIND + ENDOT*VHINGE(3,J,N) -! C -! C---------- linearize about zero deflection (COSD=1, SIND=0) -! ENV_D(1,I,N) = ENV_D(1,I,N) + EQ(1)*ANG_DDC -! ENV_D(2,I,N) = ENV_D(2,I,N) + EQ(2)*ANG_DDC -! ENV_D(3,I,N) = ENV_D(3,I,N) + EQ(3)*ANG_DDC -! 100 CONTINUE -! 101 CONTINUE -! C -! 105 CONTINUE -! 10 CONTINUE -! C -! LENC = .TRUE. -! C -! RETURN -! END ! ENCALCMSH \ No newline at end of file diff --git a/src/f2py/libavl.pyf b/src/f2py/libavl.pyf index 50c9845..f5de851 100644 --- a/src/f2py/libavl.pyf +++ b/src/f2py/libavl.pyf @@ -139,34 +139,6 @@ python module libavl ! in integer :: isurf end subroutine makesurf_mesh - subroutine adjust_mesh_spacing(isurf, nx, ny, mesh, iptloc, nsecsurf) ! in :libavl:amake.f - integer :: isurf, nx, ny, nsecsurf - integer, intent(inout) :: iptloc(nsecsurf) - real*8 :: mesh(3,nx,ny) - end subroutine adjust_mesh_spacing - - !subroutine getcam(x, y, n, xc, yc, tc, nc, lnorm) ! in :libavl:airutil.f - !integer, intent(in) :: n - !integer, intent(inout) :: nc - !real, dimension(nc), intent(out) :: xc, yc, tc - !real, dimension(n), intent(in) :: x, y - !logical, intent(in) :: lnorm - !end subroutine getcam - - !subroutine getcam(x, y, n, xc, yc, tc, nc, lnorm) ! in :libavl:airutil.f - !integer, intent(inout) :: nc - !integer n - !real*8 x(n), y(n), xc(nc), yc(nc), tc(nc) - !logical lnorm - !end subroutine getcam - - !subroutine akima(x, y, n, xx, yy, slp) ! in :libavl:sgutil.f - !integer, intent(in) :: n - !real, dimension(n), intent(in) :: x, y - !real, dimension(*), intent(in) :: xx - !real, dimension(*), intent(out) :: yy, slp - !end subroutine akima - subroutine set_section_coordinates(isec, isurf, x, y, n, nin, xfmin, xfmax, storecoords) ! in :libavl:amake.f integer :: isec, isurf, n, nin real*8 :: x(n), y(n), xfmin, xfmax @@ -179,11 +151,5 @@ python module libavl ! in logical :: storecoords end subroutine set_body_coordinates - !subroutine update_surface_mesh_HACK(isurf,mesh,nx,ny,iptloc,nsecsurf,lcount,lcall) ! in :libavl:amake.f - !integer :: isurf, nx, ny, nsecsurf - !logical :: lcount, lcall - !real*8 :: mesh(3,nx,ny) - !integer :: iptloc(nsecsurf) - !end subroutine update_surfaces_mesh end interface end python module libavl diff --git a/tests/test_input_dict.py b/tests/test_input_dict.py index 1924029..9058078 100644 --- a/tests/test_input_dict.py +++ b/tests/test_input_dict.py @@ -71,32 +71,29 @@ surf = {"Wing": {}} cont_surfs = { - # Control Surfaces - "icontd": [np.array([0], dtype=np.int32), np.array([], dtype=np.int32)], # control variable index - "xhinged": [np.array([0.8]), np.array([], dtype=np.float64)], # x/c location of hinge - "vhinged": [ - np.array([[0.0, 0.0, 0.0]]), - np.array([], dtype=np.float64), - ], # vector giving hinge axis about which surface rotates - "gaind": [np.array([1.0]), np.array([], dtype=np.float64)], # control surface gain - "refld": [ - np.array([1.0]), - np.array([], dtype=np.float64), - ], # control surface reflection, sign of deflection for duplicated surface + "control_assignments": { + "flap" : {"assignment":np.arange(0,1), + "xhinged": 0.8, # x/c location of hinge + "vhinged": np.zeros(3), # vector giving hinge axis about which surface rotates + "gaind": 1.0, # control surface gain + "refld": 1.0 # control surface reflection, sign of deflection for duplicated surface + } + }, } des_var = { - # Design Variables (AVL) - "idestd": [np.array([0], dtype=np.int32), np.array([], dtype=np.int32)], # design variable index - "gaing": [np.array([1.0]), np.array([], dtype=np.float64)], # desgin variable gain + "design_var_assignments": { + "des" : {"assignment":np.arange(0,1), + "gaing":1.0} + }, } cont_surf_names = { - "dname": np.array(["flap"]), # Name of control input for each corresonding index + "dname": ["flap"], # Name of control input for each corresonding index } des_var_names = { - "gname": np.array(["des"]), # Name of design var for each corresonding index + "gname": ["des"], # Name of design var for each corresonding index } section_geom_naca = { From 48da6af763422e5ace1b19b8659da3c471bfb1ac Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 3 Feb 2026 00:23:38 -0500 Subject: [PATCH 28/49] Remove contractions from fortran comments --- src/amake.f | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/amake.f b/src/amake.f index fbaaed3..b0e27f3 100644 --- a/src/amake.f +++ b/src/amake.f @@ -730,7 +730,7 @@ subroutine makesurf_mesh(isurf) ! Set NK from input data (python layer will ensure this is consistent) NK(ISURF) = NVC(ISURF) - ! We need to start counting strips now since it's a global count + ! We need to start counting strips now since it is a global count idx_strip = JFRST(ISURF) ! Bypass the entire spanwise node generation routine and go straight to store counters @@ -769,7 +769,7 @@ subroutine makesurf_mesh(isurf) ! Set spanwise elements to 0 NJ(ISURF) = 0 - ! Check control and design vars (input routine should've already checked this tbh) + ! Check control and design vars IF(NCONTROL.GT.NDMAX) THEN WRITE(*,*) '*** Too many control variables. Increase NDMAX to', & NCONTROL @@ -893,7 +893,7 @@ subroutine makesurf_mesh(isurf) ! Strip geometric incidence angle at the mid-point ! This is strip incidence angle is computed from the LE and TE points ! of the given geometry and is completely independent of AINC - ! This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isn't flattened + ! This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isnt flattened GINCSTRIP(idx_strip) = atan2(((mesh_surf(3,idx_node_nx) & + mesh_surf(3,idx_node_nx_yp1))/2.- (mesh_surf(3,idx_node) + & mesh_surf(3,idx_node_yp1))/2.), @@ -1084,7 +1084,7 @@ subroutine makesurf_mesh(isurf) ! Left bound vortex points idx_node = flatidx(idx_x,idx_y,isurf) - ! Compute the panel's left side chord + ! Compute the panel left side chord dc1 = sqrt((mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))**2 & + (mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node))**2) @@ -1096,7 +1096,7 @@ subroutine makesurf_mesh(isurf) RV1(3,idx_vor) = RLE1(3,idx_strip) RV1(1,idx_vor) = RLE1(1,idx_strip) + dx1 + (dc1/4.) - ! Compute the panel's left side angle + ! Compute the panel left side angle a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) ! Place vortex at panel quarter chord of the true mesh @@ -1104,7 +1104,7 @@ subroutine makesurf_mesh(isurf) RV1MSH(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) RV1MSH(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) else - ! Compute the panel's left side angle + ! Compute the panel left side angle a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) ! Place vortex at panel quarter chord @@ -1120,7 +1120,7 @@ subroutine makesurf_mesh(isurf) ! Right bound vortex points idx_node_yp1 = flatidx(idx_x,idx_y+1,isurf) - ! Compute the panel's right side chord + ! Compute the panel right side chord dc2 = sqrt((mesh_surf(1,idx_node_yp1+1) & - mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_yp1+1) & - mesh_surf(3,idx_node_yp1))**2) @@ -1133,7 +1133,7 @@ subroutine makesurf_mesh(isurf) RV2(3,idx_vor) = RLE2(3,idx_strip) RV2(1,idx_vor) = RLE2(1,idx_strip) + dx2 + (dc2/4.) - ! Compute the panel's right side angle + ! Compute the panel right side angle a2 = atan2((mesh_surf(3,idx_node_yp1+1) - & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - & mesh_surf(1,idx_node_yp1))) @@ -1142,7 +1142,7 @@ subroutine makesurf_mesh(isurf) RV2MSH(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) RV2MSH(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) else - ! Compute the panel's right side angle + ! Compute the panel right side angle a2 = atan2((mesh_surf(3,idx_node_yp1+1) - & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - & mesh_surf(1,idx_node_yp1))) @@ -1158,7 +1158,7 @@ subroutine makesurf_mesh(isurf) end if ! Mid-point bound vortex points - ! Compute the panel's mid-point chord + ! Compute the panel mid-point chord ! Panels themselves can never be curved so just interpolate the chord ! store as the panel chord in common block DXV(idx_vor) = (dc1+dc2)/2. @@ -1276,7 +1276,7 @@ subroutine makesurf_mesh(isurf) SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - ! Associate the panel with it's strip's chord and component + ! Associate the panel with strip chord and component CHORDV(idx_vor) = CHORD(idx_strip) NSURFV(idx_vor) = LSCOMP(isurf) From 14d1afd5bccd4f21ba2d6e31408ffaf46d279103 Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 3 Feb 2026 01:54:50 -0500 Subject: [PATCH 29/49] Manually clean up some things to complete the merge --- src/amake.f | 16 ++++++++-------- src/includes/AVL_ad_seeds.inc | 22 +++++++++++++++++++--- 2 files changed, 27 insertions(+), 11 deletions(-) diff --git a/src/amake.f b/src/amake.f index bf7d94d..b5b6f23 100644 --- a/src/amake.f +++ b/src/amake.f @@ -1064,7 +1064,7 @@ subroutine makesurf_mesh(isurf) NVSTRP(idx_strip) = NVC(isurf) ! Associate the strip with the surface - NSURFS(idx_strip) = isurf + LSSURF(idx_strip) = isurf ! Prepare for cross section interpolation NSL = NASEC(idx_strip , isurf) @@ -1278,7 +1278,7 @@ subroutine makesurf_mesh(isurf) ! Associate the panel with strip chord and component CHORDV(idx_vor) = CHORD(idx_strip) - NSURFV(idx_vor) = LSCOMP(isurf) + LVCOMP(idx_vor) = LNCOMP(isurf) ! Enforce no penetration at the control point LVNC(idx_vor) = .true. @@ -2008,7 +2008,7 @@ SUBROUTINE ENCALC DO 10 J = 1, NSTRIP ! Since we cannot seperate the encalc routine for direct mesh assignment we have to make it a branch here - if (lsurfmsh(nsurfs(J))) then + if (lsurfmsh(lssurf(J))) then ! Calculate normal vector for the strip (normal to X axis) ! we can't just interpolate this anymore given that @@ -2112,7 +2112,7 @@ SUBROUTINE ENCALC ENC_G(3,I,N) = 0. ENDDO - if (lsurfmsh(nsurfs(J))) then + if (lsurfmsh(lssurf(J))) then ! Define unit vector along bound leg DXB = RV2MSH(1,I)-RV1MSH(1,I) ! right h.v. pt - left h.v. pt DYB = RV2MSH(2,I)-RV1MSH(2,I) @@ -2148,7 +2148,7 @@ SUBROUTINE ENCALC SINC = SIN(ANG) COSC = COS(ANG) - if (lsurfmsh(nsurfs(J))) then + if (lsurfmsh(lssurf(J))) then ! direct mesh assignemnt branch ! now we compute the chordwise panel vector ! note that panel's chordwise vector has contributions @@ -2198,7 +2198,7 @@ SUBROUTINE ENCALC ! The derivative here also changes if we use a custom mesh ! Note the derivative is only wrt to AVL incidence vars ! as those are the vars AVL DVs can support - if (lsurfmsh(nsurfs(J))) then + if (lsurfmsh(lssurf(J))) then EC(1) = -SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) & + ES(3)*COSC*ec_msh(3) EC(2) = -ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC)*ec_msh(2) @@ -2255,7 +2255,7 @@ SUBROUTINE ENCALC C SINC = SIN(ANG) COSC = COS(ANG) - if (lsurfmsh(nsurfs(J))) then + if (lsurfmsh(lssurf(J))) then ! direct mesh assignment branch ! see explanation in section above for control point normals ! ec_msh was already computed in that section @@ -2274,7 +2274,7 @@ SUBROUTINE ENCALC end if DO N = 1, NDESIGN - if (lsurfmsh(nsurfs(J))) then + if (lsurfmsh(lssurf(J))) then ! Direct mesh assignment branch EC(1) = -SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) & + ES(3)*COSC*ec_msh(3) diff --git a/src/includes/AVL_ad_seeds.inc b/src/includes/AVL_ad_seeds.inc index c8567f2..dae2b9f 100644 --- a/src/includes/AVL_ad_seeds.inc +++ b/src/includes/AVL_ad_seeds.inc @@ -312,6 +312,7 @@ C real(kind=avl_real) CFS_D_DIFF real(kind=avl_real) CFS_G_DIFF real(kind=avl_real) CMSURF_DIFF + real(kind=avl_real) CMSURFBAX_DIFF real(kind=avl_real) CMS_U_DIFF real(kind=avl_real) CMS_D_DIFF real(kind=avl_real) CMS_G_DIFF @@ -345,6 +346,7 @@ C & CFS_D_DIFF(3,NFMAX,NDMAX), & CFS_G_DIFF(3,NFMAX,NGMAX), & CMSURF_DIFF(3,NFMAX), + & CMSURFBAX_DIFF(3,NFMAX), & CMS_U_DIFF(3,NFMAX,NUMAX), & CMS_D_DIFF(3,NFMAX,NDMAX), & CMS_G_DIFF(3,NFMAX,NGMAX), @@ -419,6 +421,10 @@ C & SSPACE_DIFF(NFMAX), & SSPACES_DIFF(NSECMAX, NFMAX), & XYZLES_DIFF(3, NSECMAX, NFMAX), + & XSEC_DIFF(IBX, NSECMAX, NFMAX), + & YSEC_DIFF(IBX, NSECMAX, NFMAX), + & XFMIN_R_DIFF(NSECMAX, NFMAX), + & XFMAX_R_DIFF(NSECMAX, NFMAX), & XLASEC_DIFF(IBX, NSECMAX, NFMAX), & ZLASEC_DIFF(IBX, NSECMAX, NFMAX), & XUASEC_DIFF(IBX, NSECMAX, NFMAX), @@ -436,11 +442,19 @@ C & VHINGED_DIFF(3, ICONX, NSECMAX, NFMAX), & GAIND_DIFF(ICONX, NSECMAX, NFMAX), & REFLD_DIFF(ICONX, NSECMAX, NFMAX), - & GAING_DIFF(ICONX, NSECMAX, NFMax) + & GAING_DIFF(ICONX, NSECMAX, NFMAX) C real(kind=avl_real) MSHBLK_DIFF + real(kind=avl_real) RV1MSH_DIFF + real(kind=avl_real) RV2MSH_DIFF + real(kind=avl_real) RVMSH_DIFF + real(kind=avl_real) RCMSH_DIFF COMMON /SURF_MESH_R_DIFF/ - & MSHBLK_DIFF(3, 4*NVMAX) + & MSHBLK_DIFF(3, 4*NVMAX), + & RV1MSH_DIFF(3,NVMAX), + & RV2MSH_DIFF(3,NVMAX), + & RVMSH_DIFF(3,NVMAX), + & RCMSH_DIFF(3,NVMAX) C real(kind=avl_real) RLE_DIFF real(kind=avl_real) CHORD_DIFF @@ -667,6 +681,7 @@ C real(kind=avl_real) CLBDY_DIFF real(kind=avl_real) CFBDY_DIFF real(kind=avl_real) CMBDY_DIFF + real(kind=avl_real) CMBDYBAX_DIFF COMMON /BODY_R_DIFF/ & ELBDY_DIFF(NBMAX), & SRFBDY_DIFF(NBMAX), @@ -676,7 +691,8 @@ C & CYBDY_DIFF(NBMAX), & CLBDY_DIFF(NBMAX), & CFBDY_DIFF(3,NBMAX), - & CMBDY_DIFF(3,NBMAX) + & CMBDY_DIFF(3,NBMAX), + & CMBDYBAX_DIFF(3,NBMAX) C real(kind=avl_real) AMACH_DIFF real(kind=avl_real) VC_DIFF From 5672f7e9d3017cf5f0838a3ce6483d65119ef259 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 3 Feb 2026 12:40:42 -0500 Subject: [PATCH 30/49] Cleaned up some utility functions in the python class --- optvl/optvl_class.py | 68 +++++++++++--------------------------------- 1 file changed, 17 insertions(+), 51 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 1388128..51772c8 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1191,13 +1191,13 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, flatten:bool=True, update_nv # Flag surface as using mesh geometry self.avl.SURF_MESH_L.LSURFMSH[idx_surf] = True - def get_mesh(self, idx_surf: int, get_full_mesh: bool = False, get_iptloc: bool = False): - """ + def get_mesh(self, idx_surf: int, concat_dup_mesh: bool = False): + """Returns the current set mesh coordinates from AVL as a numpy array. + Note this is intended for Args: idx_surf (int): the surface to get the mesh for - get_full_mesh (bool): concatenates and returns the meshes for idx_surf and idx_surf + 1, for use with duplicated surfaces - get_iptloc (bool) : should the iptloc vector for the surface be returned + concat_dup_mesh (bool): concatenates and returns the meshes for idx_surf and idx_surf + 1, for use with duplicated surfaces """ # Check if surface is using mesh geometry @@ -1220,7 +1220,7 @@ def get_mesh(self, idx_surf: int, get_full_mesh: bool = False, get_iptloc: bool mesh[:,:,1] = -mesh[:,:,1] + self.y_offsets[idx_surf-1] # Concatenate with duplicate - if get_full_mesh: + if concat_dup_mesh: if imags[idx_surf] < 0: raise RuntimeError(f"Concatenating a duplicated surface, {idx_surf}, with the next surface!") elif imags[idx_surf+1] > 0: @@ -1233,35 +1233,7 @@ def get_mesh(self, idx_surf: int, get_full_mesh: bool = False, get_iptloc: bool # Concatenate them mesh = np.hstack([mesh,mesh_dup]) - # Get iptloc - iptloc = None - if get_iptloc: - iptloc = self.get_avl_fort_arr("SURF_MESH_I","IPTSEC",slicer=(idx_surf,slice(None,self.get_num_sections(self.get_surface_names()[idx_surf])))) - 1 - return mesh, iptloc - else: - return mesh - - - # Only add +1 for Fortran indexing if we are not explictly telling the routine to use - # nspans by passing in all zeros - # if not (iptloc == 0).all(): - # iptloc += 1 - # # set iptloc - # self.set_avl_fort_arr("SURF_MESH_I","IPTSEC",iptloc,slicer=(idx_surf,slice(None,len(iptloc)))) - - # Compute and set the mesh starting index - # if idx_surf != 0: - # self.mesh_idx_first[idx_surf] = self.mesh_idx_first[idx_surf-1] + 3*(self.avl.SURF_GEOM_I.NVS[idx_surf-1]+1)*(self.avl.SURF_GEOM_I.NVC[idx_surf-1]+1) - - # self.set_avl_fort_arr("SURF_MESH_I","MFRST",self.mesh_idx_first[idx_surf]+1,slicer=idx_surf) - - # # Reshape the mesh - # # mesh = mesh.ravel(order="C").reshape((3,mesh.shape[0]*mesh.shape[1]), order="F") - # mesh = mesh.transpose((1,0,2)).reshape((mesh.shape[0]*mesh.shape[1],3)) - - # # Set the mesh - # self.set_avl_fort_arr("SURF_MESH_R","MSHBLK",mesh, slicer=(slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+nx*ny),slice(0,3))) - + return mesh def set_section_naca(self, isec: int, isurf: int, nasec: int, naca: str, xfminmax: np.ndarray): @@ -3295,7 +3267,7 @@ def _str_list_to_fort_char_array(self, strList, num_max_char): def __fort_char_array_to_str(self, fort_string: str) -> str: # TODO: need a more general solution for |S type - # SB: This should fix it but keep things commented out in case + # SAB: This should fix it but keep things commented out in case if fort_string.dtype == np.dtype("|S0"): # there are no characters in the sting to add @@ -4711,11 +4683,6 @@ def add_mesh_plot_3d_direct( mesh_style="--", mesh_linewidth=0.3, show_mesh: bool = False, - # show_avl_geom: bool = False, - # show_avl_mesh: bool = False, - # avl_mesh_color: str = "red", - # avl_mesh_style: str = "--", - # show_avl_control_points: bool = False ): """Plots the true mesh assigned to SURF_MESH AVL common block data on a 3D axis. Can also plot the mesh stored in SURF on the same axis. @@ -4748,20 +4715,19 @@ def add_mesh_plot_3d_direct( for j in range(mesh_x.shape[1]): axis.plot(mesh_x[:, j], mesh_y[:, j],mesh_z[:, j], mesh_style, color=color, lw=mesh_linewidth, alpha=1.0) - # if show_avl_geom: - # self.add_mesh_plot_3d_avl( - # axis, - # color = avl_mesh_color, - # mesh_style=avl_mesh_style, - # mesh_linewidth=mesh_linewidth, - # show_mesh = show_avl_mesh, - # show_control_points = show_avl_control_points) def plot_geom_3d(self, axes=None, plot_avl_mesh = True, plot_direct_mesh = False): - """Generate a matplotlib plot of geometry + """Generates a plot of the VLM mesh on a 3d axis. + By default the flat version of the mesh that satisfies AVL's VLM assumptions is plotted. + This is either the mesh that comes as a result of AVL's standard geometry specification system + or the custom user assigned mesh after it has undergone the transformation needed to flatten it to + satify the VLM assumptions. There is also an option to overlay the directly assigned mesh. This will + plot user assigned mesh as is with no modifications. Args: axes: Matplotlib axis object to add the plots too. If none are given, the axes will be generated. + plot_avl_mesh: If True the AVL flattenned mesh is plotted on the axis + plot_direct_mesh: If True the user assigned mesh will be plotted as is """ if axes == None: @@ -4773,7 +4739,7 @@ def plot_geom_3d(self, axes=None, plot_avl_mesh = True, plot_direct_mesh = False ax1._axis3don = False plt.subplots_adjust(left=0.025, right=0.925, top=0.925, bottom=0.025) else: - ax1, ax2 = axes + ax1 = axes if plot_avl_mesh: self.add_mesh_plot_3d_avl(ax1, @@ -4790,7 +4756,7 @@ def plot_geom_3d(self, axes=None, plot_avl_mesh = True, plot_direct_mesh = False mesh_linewidth=0.3, show_mesh= True) - if axes == None: + if axes is None: # assume that if we don't provide axes that we want to see the plot plt.axis("equal") plt.show() From 889b00d626184803736f1cd891d9535a1e14cd76 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 3 Feb 2026 12:41:13 -0500 Subject: [PATCH 31/49] Some things missed from last commit --- optvl/optvl_class.py | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 51772c8..967b992 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -4684,8 +4684,7 @@ def add_mesh_plot_3d_direct( mesh_linewidth=0.3, show_mesh: bool = False, ): - """Plots the true mesh assigned to SURF_MESH AVL common block data on a 3D axis. - Can also plot the mesh stored in SURF on the same axis. + """Plots the mesh assigned to SURF_MESH AVL common block data on a 3D axis. Args: axis: axis to add the plot to From 9f384d20ef09c151ce920894ddb90216c438f4b4 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 3 Feb 2026 12:52:57 -0500 Subject: [PATCH 32/49] fix naca specification for meshes --- optvl/utils/check_surface_dict.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index 5e4d65f..7ecd3aa 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -360,8 +360,8 @@ def pre_check_input_dict(input_dict: dict): ) else: - # If the user provides a scalar expand it out for all sections - if isinstance(input_dict["surfaces"][surface][key],(int,float,np.int32,np.float64)): + # If the user provides a scalar or string expand it out for all sections + if isinstance(input_dict["surfaces"][surface][key],(int,float,np.int32,np.float64,str)): input_dict["surfaces"][surface][key] = np.tile(input_dict["surfaces"][surface][key],(input_dict["surfaces"][surface]["num_sections"])) elif input_dict["surfaces"][surface][key].ndim > 1: raise ValueError( From 0578fb48ac3a999ace90a13058709996170ba8f3 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 3 Feb 2026 13:20:24 -0500 Subject: [PATCH 33/49] Fix tecplot writing from input dict for now --- optvl/optvl_class.py | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 967b992..2f2d1ad 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -727,7 +727,10 @@ def check_type(key, avl_vars, given_val, cast_type=True): raise ValueError(f"Key {key} not found in input dictionary but is required") elif key == "title": # We need to apply this function to the title string so that the tecplot file writing works correctly - val = self._str_to_fort_str(input_dict[key],num_max_char=120) + # val = self._str_to_fort_str(input_dict[key],num_max_char=120) + # NOTE: SAB this seems to have broken again in AVL 3.52. Need to manually set it for now + val = "dummy" + self.avl.CASE_C.TITLE = self._str_to_fort_str(input_dict[key], num_max_char=120) else: val = input_dict[key] From 4a17e21a4cadea6bb02331bf223008430fa3aa79 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Wed, 4 Feb 2026 23:52:43 -0500 Subject: [PATCH 34/49] Fixed multiple mesh surfaces not working correctly --- optvl/optvl_class.py | 3 +- src/amake.f | 89 ++++++++++++++++++++++---------------------- 2 files changed, 47 insertions(+), 45 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 2f2d1ad..657774c 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -1050,6 +1050,7 @@ def check_type(key, avl_vars, given_val, cast_type=True): # Insert duplicate into the mesh first index array self.mesh_idx_first = np.insert(self.mesh_idx_first,idx_surf+1,self.mesh_idx_first[idx_surf]) self.y_offsets[idx_surf] = surf_dict["yduplicate"] + self.y_offsets = np.insert(self.y_offsets,idx_surf+1,self.y_offsets[idx_surf]) self.avl.CASE_I.NSURF += 1 idx_surf += 1 @@ -1180,7 +1181,7 @@ def set_mesh(self, idx_surf: int, mesh: np.ndarray, flatten:bool=True, update_nv # Compute and set the mesh starting index if idx_surf != 0: - self.mesh_idx_first[idx_surf] = self.mesh_idx_first[idx_surf-1] + 3*(self.avl.SURF_GEOM_I.NVS[idx_surf-1]+1)*(self.avl.SURF_GEOM_I.NVC[idx_surf-1]+1) + self.mesh_idx_first[idx_surf] = self.mesh_idx_first[idx_surf-1] + (self.avl.SURF_GEOM_I.NVS[idx_surf-1]+1)*(self.avl.SURF_GEOM_I.NVC[idx_surf-1]+1) self.set_avl_fort_arr("SURF_MESH_I","MFRST",self.mesh_idx_first[idx_surf]+1,slicer=idx_surf) diff --git a/src/amake.f b/src/amake.f index b5b6f23..fdc31cf 100644 --- a/src/amake.f +++ b/src/amake.f @@ -644,7 +644,7 @@ integer function flatidx(idx_x, idx_y, idx_surf) include 'AVL.INC' ! store MFRST and NVC in the common block integer idx_x, idx_y, idx_surf - flatidx = idx_x + (idx_y - 1) * (NVC(idx_surf)+1) + flatidx = idx_x + (idx_y - 1) * (NVC(idx_surf)+1) return end function flatidx @@ -789,8 +789,9 @@ subroutine makesurf_mesh(isurf) ! Set reference information for the strip ! This code was used in the original to loop over strips in a section. ! We will just reuse the variables here - iptl = idx_strip - iptr = idx_strip + 1 + idx_y = idx_strip - JFRST(isurf) + 1 + iptl = idx_y + iptr = idx_y + 1 NJ(isurf) = NJ(isurf) + 1 @@ -805,12 +806,12 @@ subroutine makesurf_mesh(isurf) idx_node_nx = flatidx(nx,iptr,isurf) CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) - CLAFL = CLAF(idx_strip, isurf) - CLAFR = CLAF(idx_strip+1,isurf) + CLAFL = CLAF(iptl, isurf) + CLAFR = CLAF(iptr,isurf) ! Linearly interpolate the incidence projections over the STRIP - AINCL = AINCS(idx_strip,isurf)*DTR + ADDINC(isurf)*DTR - AINCR = AINCS(idx_strip+1,isurf)*DTR + ADDINC(isurf)*DTR + AINCL = AINCS(iptl,isurf)*DTR + ADDINC(isurf)*DTR + AINCR = AINCS(iptr,isurf)*DTR + ADDINC(isurf)*DTR CHSINL = CHORDL*SIN(AINCL) CHSINR = CHORDR*SIN(AINCR) CHCOSL = CHORDL*COS(AINCL) @@ -821,11 +822,11 @@ subroutine makesurf_mesh(isurf) DO N = 1, NCONTROL ISCONL(N) = 0 ISCONR(N) = 0 - DO ISCON = 1, NSCON(idx_strip,isurf) - IF(ICONTD(ISCON,idx_strip,isurf) .EQ.N) ISCONL(N) = ISCON + DO ISCON = 1, NSCON(iptl,isurf) + IF(ICONTD(ISCON,iptl,isurf) .EQ.N) ISCONL(N) = ISCON ENDDO - DO ISCON = 1, NSCON(idx_strip+1,isurf) - IF(ICONTD(ISCON,idx_strip+1,isurf).EQ.N) ISCONR(N) = ISCON + DO ISCON = 1, NSCON(iptr,isurf) + IF(ICONTD(ISCON,iptr,isurf).EQ.N) ISCONR(N) = ISCON ENDDO ENDDO @@ -838,17 +839,17 @@ subroutine makesurf_mesh(isurf) CHCOSL_G(N) = 0. CHCOSR_G(N) = 0. - DO ISDES = 1, NSDES(idx_strip,isurf) - IF(IDESTD(ISDES,idx_strip,isurf).EQ.N) THEN - CHSINL_G(N) = CHCOSL * GAING(ISDES,idx_strip,isurf)*DTR - CHCOSL_G(N) = -CHSINL * GAING(ISDES,idx_strip,isurf)*DTR + DO ISDES = 1, NSDES(iptl,isurf) + IF(IDESTD(ISDES,iptl,isurf).EQ.N) THEN + CHSINL_G(N) = CHCOSL * GAING(ISDES,iptl,isurf)*DTR + CHCOSL_G(N) = -CHSINL * GAING(ISDES,iptl,isurf)*DTR ENDIF ENDDO - DO ISDES = 1, NSDES(idx_strip+1,isurf) - IF(IDESTD(ISDES,idx_strip+1,isurf).EQ.N) THEN - CHSINR_G(N) = CHCOSR * GAING(ISDES,idx_strip+1,isurf)*DTR - CHCOSR_G(N) = -CHSINR * GAING(ISDES,idx_strip+1,isurf)*DTR + DO ISDES = 1, NSDES(iptr,isurf) + IF(IDESTD(ISDES,iptr,isurf).EQ.N) THEN + CHSINR_G(N) = CHCOSR * GAING(ISDES,iptr,isurf)*DTR + CHCOSR_G(N) = -CHSINR * GAING(ISDES,iptr,isurf)*DTR ENDIF ENDDO ENDDO @@ -858,7 +859,7 @@ subroutine makesurf_mesh(isurf) ! Note these computations assume the mesh is not necessarily planar ! ultimately if/when we flatten the mesh into a planar one we will want ! to use the leading edge positions and chords from the original input mesh - idx_y = idx_strip - JFRST(isurf) + 1 + ! Strip left side idx_node = flatidx(1,idx_y,isurf) @@ -982,14 +983,14 @@ subroutine makesurf_mesh(isurf) ELSE ! control variable # N is active here - GAINDA(N) = GAIND(ICL,idx_strip ,isurf)*(1.0-FC) - & + GAIND(ICR,idx_strip+1,isurf)* FC + GAINDA(N) = GAIND(ICL,iptl ,isurf)*(1.0-FC) + & + GAIND(ICR,iptr,isurf)* FC ! SAB Note: This interpolation ensures that the hinge line is ! is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware ! A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord - XHD = CHORDL*XHINGED(ICL,idx_strip ,isurf)*(1.0-FC) - & + CHORDR*XHINGED(ICR,idx_strip+1,isurf)* FC + XHD = CHORDL*XHINGED(ICL,iptl ,isurf)*(1.0-FC) + & + CHORDR*XHINGED(ICR,iptr,isurf)* FC IF(XHD.GE.0.0) THEN ! TE control surface, with hinge at XHD XLED(N) = XHD @@ -1000,18 +1001,18 @@ subroutine makesurf_mesh(isurf) XTED(N) = -XHD ENDIF - VHX = VHINGED(1,ICL,idx_strip,isurf)*XYZSCAL(1,isurf) - VHY = VHINGED(2,ICL,idx_strip,isurf)*XYZSCAL(2,isurf) - VHZ = VHINGED(3,ICL,idx_strip,isurf)*XYZSCAL(3,isurf) + VHX = VHINGED(1,ICL,iptl,isurf)*XYZSCAL(1,isurf) + VHY = VHINGED(2,ICL,iptl,isurf)*XYZSCAL(2,isurf) + VHZ = VHINGED(3,ICL,iptl,isurf)*XYZSCAL(3,isurf) VSQ = VHX**2 + VHY**2 + VHZ**2 IF(VSQ.EQ.0.0) THEN ! default: set hinge vector along hingeline ! We are just setting the hinge line across the section ! this assumes the hinge is linear even for a nonlinear wing VHX = mesh_surf(1,idx_noder) - & + ABS(CHORDR*XHINGED(ICR,idx_strip+1,isurf)) + & + ABS(CHORDR*XHINGED(ICR,iptr,isurf)) & - mesh_surf(1,idx_nodel) - & - ABS(CHORDL*XHINGED(ICL,idx_strip,isurf)) + & - ABS(CHORDL*XHINGED(ICL,iptl,isurf)) VHY = mesh_surf(2,idx_noder) & - mesh_surf(2,idx_nodel) VHZ = mesh_surf(3,idx_noder) @@ -1027,7 +1028,7 @@ subroutine makesurf_mesh(isurf) VHINGE(2,idx_strip,N) = VHY/VMOD VHINGE(3,idx_strip,N) = VHZ/VMOD - VREFL(idx_strip,N) = REFLD(ICL,idx_strip, isurf) + VREFL(idx_strip,N) = REFLD(ICL,iptl, isurf) IF(XHD .GE. 0.0) THEN PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD @@ -1044,8 +1045,8 @@ subroutine makesurf_mesh(isurf) ! Interpolate CD-CL polar defining data from input to strips DO idx_coef = 1, 6 CLCD(idx_coef,idx_strip) = (1.0-fc)* - & CLCDSEC(idx_coef,idx_strip,isurf) + - & fc*CLCDSEC(idx_coef,idx_strip+1,isurf) + & CLCDSEC(idx_coef,iptl,isurf) + + & fc*CLCDSEC(idx_coef,iptr,isurf) END DO ! If the min drag is zero flag the strip as no-viscous data LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) @@ -1067,8 +1068,8 @@ subroutine makesurf_mesh(isurf) LSSURF(idx_strip) = isurf ! Prepare for cross section interpolation - NSL = NASEC(idx_strip , isurf) - NSR = NASEC(idx_strip+1, isurf) + NSL = NASEC(iptl , isurf) + NSR = NASEC(iptr, isurf) ! CHORDC = CHORD(idx_strip) @@ -1249,10 +1250,10 @@ subroutine makesurf_mesh(isurf) ! Set the camber slopes for the panel ! Camber slope at control point - CALL AKIMA(XASEC(1,idx_strip, isurf),SASEC(1,idx_strip, isurf), + CALL AKIMA(XASEC(1,iptl, isurf),SASEC(1,iptl, isurf), & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,idx_strip+1,isurf),SASEC(1,idx_strip+1,isurf), + CALL AKIMA(XASEC(1,iptr,isurf),SASEC(1,iptr,isurf), & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) @@ -1263,10 +1264,10 @@ subroutine makesurf_mesh(isurf) & + fc *(CHORDR/CHORD(idx_strip))*SLOPER ! Camber slope at vortex mid-point - CALL AKIMA(XASEC(1,idx_strip, isurf),SASEC(1,idx_strip, isurf), + CALL AKIMA(XASEC(1,iptl, isurf),SASEC(1,iptl, isurf), & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,idx_strip+1,isurf),SASEC(1,idx_strip+1,isurf), + CALL AKIMA(XASEC(1,iptr,isurf),SASEC(1,iptr,isurf), & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) & /CHORD(idx_strip),SLOPER, DSDX) @@ -1323,17 +1324,17 @@ subroutine makesurf_mesh(isurf) ! & - RLE2(1,idx_strip))/CHORD2(idx_strip) ! Interpolate cross section on left side - CALL AKIMA( XLASEC(1,idx_strip,isurf), ZLASEC(1,idx_strip,isurf), + CALL AKIMA( XLASEC(1,iptl,isurf), ZLASEC(1,iptl,isurf), & NSL,xptxind1, ZL_L, DSDX ) - CALL AKIMA( XUASEC(1,idx_strip,isurf), ZUASEC(1,idx_strip,isurf), + CALL AKIMA( XUASEC(1,iptl,isurf), ZUASEC(1,iptl,isurf), & NSL,xptxind1, ZU_L, DSDX ) ! Interpolate cross section on right side - CALL AKIMA( XLASEC(1,idx_strip+1,isurf), - & ZLASEC(1,idx_strip+1,isurf),NSR, xptxind1, ZL_R, DSDX) + CALL AKIMA( XLASEC(1,iptr,isurf), + & ZLASEC(1,iptr,isurf),NSR, xptxind1, ZL_R, DSDX) - CALL AKIMA( XUASEC(1,idx_strip+1,isurf), - & ZUASEC(1,idx_strip+1,isurf),NSR, xptxind1, ZU_R, DSDX) + CALL AKIMA( XUASEC(1,iptr,isurf), + & ZUASEC(1,iptr,isurf),NSR, xptxind1, ZU_R, DSDX) ! Compute the left aft node of panel From 5acbab97a032ae2b7abfe8a137de95b0e3dfbad4 Mon Sep 17 00:00:00 2001 From: Joshua Anibal Date: Fri, 6 Feb 2026 08:57:27 -0800 Subject: [PATCH 35/49] formatting of fortran code and removed one batch of commented prints --- src/aic.f | 5 - src/amake.f | 1123 ++++++++++++++++++++++++++------------------------- 2 files changed, 566 insertions(+), 562 deletions(-) diff --git a/src/aic.f b/src/aic.f index 299b4f1..05c104e 100644 --- a/src/aic.f +++ b/src/aic.f @@ -124,11 +124,6 @@ SUBROUTINE VVOR(BETM,IYSYM,YSYM,IZSYM,ZSYM, & RV2(1,J),RV2(2,J),RV2(3,J), & BETM,U,V,W,RCORE) C - ! print *, "Influence of", J, "on", I - ! print *, "U:", U - ! print *, "V:", V - ! print *, "W:", W - ! print *, "MARK" IF(IYSYM.NE.0) THEN C... Calculate the influence of the y-IMAGE vortex LBOUND = .TRUE. diff --git a/src/amake.f b/src/amake.f index fdc31cf..44efd5d 100644 --- a/src/amake.f +++ b/src/amake.f @@ -734,6 +734,7 @@ subroutine makesurf_mesh(isurf) idx_strip = JFRST(ISURF) ! Bypass the entire spanwise node generation routine and go straight to store counters + ! skips MAKESURF 94-234 ! Index of first strip in surface ! This is normally used to store the index of each section in AVL ! but since we use strips now each is effectively just a section @@ -783,595 +784,603 @@ subroutine makesurf_mesh(isurf) ENDIF ! Instead of looping over sections just loop over all strips in the surface - do ispan = 1,ny-1 + do ispan = 1,ny-1 !ispan loop - ! Set reference information for the strip - ! This code was used in the original to loop over strips in a section. - ! We will just reuse the variables here - idx_y = idx_strip - JFRST(isurf) + 1 - iptl = idx_y - iptr = idx_y + 1 - NJ(isurf) = NJ(isurf) + 1 + ! Set reference information for the strip + ! This code was used in the original to loop over strips in a section. + ! We will just reuse the variables here + idx_y = idx_strip - JFRST(isurf) + 1 + iptl = idx_y + iptr = idx_y + 1 + NJ(isurf) = NJ(isurf) + 1 - ! We need to compute the chord and claf values at the left and right edge of the strip - ! This code was used in the original to interpolate over sections. - ! We will just reuse here to interpolate over a strip which is trivial but avoids pointless code rewrites. - idx_node = flatidx(1,iptl,isurf) - idx_node_nx = flatidx(nx,iptl,isurf) + ! We need to compute the chord and claf values at the left and right edge of the strip + ! This code was used in the original to interpolate over sections. + ! We will just reuse here to interpolate over a strip which is trivial but avoids pointless code rewrites. + idx_node = flatidx(1,iptl,isurf) + idx_node_nx = flatidx(nx,iptl,isurf) CHORDL = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 - & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) - idx_node = flatidx(1,iptr,isurf) - idx_node_nx = flatidx(nx,iptr,isurf) + & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) + idx_node = flatidx(1,iptr,isurf) + idx_node_nx = flatidx(nx,iptr,isurf) CHORDR = sqrt((mesh_surf(1,idx_node_nx)-mesh_surf(1,idx_node))**2 - & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) - CLAFL = CLAF(iptl, isurf) - CLAFR = CLAF(iptr,isurf) - - ! Linearly interpolate the incidence projections over the STRIP - AINCL = AINCS(iptl,isurf)*DTR + ADDINC(isurf)*DTR - AINCR = AINCS(iptr,isurf)*DTR + ADDINC(isurf)*DTR - CHSINL = CHORDL*SIN(AINCL) - CHSINR = CHORDR*SIN(AINCR) - CHCOSL = CHORDL*COS(AINCL) - CHCOSR = CHORDR*COS(AINCR) - - ! We need to determine which controls belong to this section - ! Bring over the routine for this from makesurf but do it for each strip now - DO N = 1, NCONTROL - ISCONL(N) = 0 - ISCONR(N) = 0 - DO ISCON = 1, NSCON(iptl,isurf) - IF(ICONTD(ISCON,iptl,isurf) .EQ.N) ISCONL(N) = ISCON - ENDDO - DO ISCON = 1, NSCON(iptr,isurf) - IF(ICONTD(ISCON,iptr,isurf).EQ.N) ISCONR(N) = ISCON - ENDDO - ENDDO + & + (mesh_surf(3,idx_node_nx)-mesh_surf(3,idx_node))**2) + CLAFL = CLAF(iptl, isurf) + CLAFR = CLAF(iptr,isurf) - ! We need to determine which dvs belong to this strip - ! and setup the chord projection gains - ! Bring over the routine for this from makesurf but setup for strips - DO N = 1, NDESIGN - CHSINL_G(N) = 0. - CHSINR_G(N) = 0. - CHCOSL_G(N) = 0. - CHCOSR_G(N) = 0. - - DO ISDES = 1, NSDES(iptl,isurf) - IF(IDESTD(ISDES,iptl,isurf).EQ.N) THEN - CHSINL_G(N) = CHCOSL * GAING(ISDES,iptl,isurf)*DTR - CHCOSL_G(N) = -CHSINL * GAING(ISDES,iptl,isurf)*DTR - ENDIF - ENDDO + ! Linearly interpolate the incidence projections over the STRIP + AINCL = AINCS(iptl,isurf)*DTR + ADDINC(isurf)*DTR + AINCR = AINCS(iptr,isurf)*DTR + ADDINC(isurf)*DTR + CHSINL = CHORDL*SIN(AINCL) + CHSINR = CHORDR*SIN(AINCR) + CHCOSL = CHORDL*COS(AINCL) + CHCOSR = CHORDR*COS(AINCR) - DO ISDES = 1, NSDES(iptr,isurf) - IF(IDESTD(ISDES,iptr,isurf).EQ.N) THEN - CHSINR_G(N) = CHCOSR * GAING(ISDES,iptr,isurf)*DTR - CHCOSR_G(N) = -CHSINR * GAING(ISDES,iptr,isurf)*DTR - ENDIF - ENDDO - ENDDO + ! We need to determine which controls belong to this section + ! Bring over the routine for this from makesurf but do it for each strip now + DO N = 1, NCONTROL + ISCONL(N) = 0 + ISCONR(N) = 0 + DO ISCON = 1, NSCON(iptl,isurf) + IF(ICONTD(ISCON,iptl,isurf) .EQ.N) ISCONL(N) = ISCON + ENDDO + DO ISCON = 1, NSCON(iptr,isurf) + IF(ICONTD(ISCON,iptr,isurf).EQ.N) ISCONR(N) = ISCON + ENDDO + ENDDO + + ! We need to determine which dvs belong to this strip + ! and setup the chord projection gains + ! Bring over the routine for this from makesurf but setup for strips + DO N = 1, NDESIGN + CHSINL_G(N) = 0. + CHSINR_G(N) = 0. + CHCOSL_G(N) = 0. + CHCOSR_G(N) = 0. + + DO ISDES = 1, NSDES(iptl,isurf) + IF(IDESTD(ISDES,iptl,isurf).EQ.N) THEN + CHSINL_G(N) = CHCOSL * GAING(ISDES,iptl,isurf)*DTR + CHCOSL_G(N) = -CHSINL * GAING(ISDES,iptl,isurf)*DTR + ENDIF + ENDDO + + DO ISDES = 1, NSDES(iptr,isurf) + IF(IDESTD(ISDES,iptr,isurf).EQ.N) THEN + CHSINR_G(N) = CHCOSR * GAING(ISDES,iptr,isurf)*DTR + CHCOSR_G(N) = -CHSINR * GAING(ISDES,iptr,isurf)*DTR + ENDIF + ENDDO + ENDDO - ! Set the strip geometry data - ! Note these computations assume the mesh is not necessarily planar - ! ultimately if/when we flatten the mesh into a planar one we will want - ! to use the leading edge positions and chords from the original input mesh + ! Set the strip geometry data + ! Note these computations assume the mesh is not necessarily planar + ! ultimately if/when we flatten the mesh into a planar one we will want + ! to use the leading edge positions and chords from the original input mesh - ! Strip left side - idx_node = flatidx(1,idx_y,isurf) - idx_node_nx = flatidx(nx,idx_y,isurf) - do idx_dim = 1,3 - RLE1(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node) - end do - CHORD1(idx_strip) = sqrt((mesh_surf(1,idx_node_nx) - & -mesh_surf(1,idx_node))**2 + (mesh_surf(3,idx_node_nx) - & -mesh_surf(3,idx_node))**2) - - ! Strip right side - idx_node_yp1 = flatidx(1,idx_y+1,isurf) - idx_node_nx_yp1 = flatidx(nx,idx_y+1,isurf) - do idx_dim = 1,3 - RLE2(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node_yp1) - end do - CHORD2(idx_strip) = sqrt((mesh_surf(1,idx_node_nx_yp1) - & -mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_nx_yp1) - & -mesh_surf(3,idx_node_yp1))**2) - - ! Strip mid-point - do idx_dim = 1,3 - ! Since the strips are linear SPANWISE we can just interpolate - RLE(idx_dim,idx_strip) = (RLE1(idx_dim,idx_strip) - & + RLE2(idx_dim,idx_strip))/2. - end do - ! The strips are not necessarily linear chord wise but by definition the chord value is - ! so we can interpolate - CHORD(idx_strip) = (CHORD1(idx_strip)+CHORD2(idx_strip))/2. - - ! Strip geometric incidence angle at the mid-point - ! This is strip incidence angle is computed from the LE and TE points - ! of the given geometry and is completely independent of AINC - ! This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isnt flattened - GINCSTRIP(idx_strip) = atan2(((mesh_surf(3,idx_node_nx) - & + mesh_surf(3,idx_node_nx_yp1))/2.- (mesh_surf(3,idx_node) + - & mesh_surf(3,idx_node_yp1))/2.), - & ((mesh_surf(1,idx_node_nx) + mesh_surf(1,idx_node_nx_yp1))/2. - & - (mesh_surf(1,idx_node) + mesh_surf(1,idx_node_yp1))/2.)) - - ! Strip width - m2 = mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_node) - m3 = mesh_surf(3,idx_node_yp1)-mesh_surf(3,idx_node) - WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) - - ! Strip LE and TE sweep slopes - tanle(idx_strip) = (mesh_surf(1,idx_node_yp1) - & -mesh_surf(1,idx_node))/WSTRIP(idx_strip) - idx_node = flatidx(nx,idx_y,isurf) - idx_node_yp1 = flatidx(nx,idx_y+1,isurf) - tante(idx_strip) = (mesh_surf(1,idx_node_yp1) - & -mesh_surf(1,idx_node))/WSTRIP(idx_strip) - - ! Compute chord projections and strip twists - ! In AVL the AINCS are not interpolated. The chord projections are - ! So we have to replicate this effect. - - ! LINEAR interpolation over the strip: left, right, and midpoint - idx_nodel = flatidx(1,iptl,isurf) - idx_noder = flatidx(1,iptr,isurf) - -! f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ -! & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) -! f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ -! & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) -! fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) -! & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) -! & -mesh_surf(2,idx_nodel)) - - ! the above expressions will always evaluate to the following for individual strips - f1 = 0.0 - f2 = 1.0 - fc = 0.5 - - ! Strip left side incidence - ! CHSIN = CHSINL + f1*(CHSINR-CHSINL) - ! CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) - AINC1(idx_strip) = ATAN2(CHSINL,CHCOSL) - - ! Strip right side incidence - ! CHSIN = CHSINL + f2*(CHSINR-CHSINL) - ! CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) - AINC2(idx_strip) = ATAN2(CHSINR,CHCOSR) - - ! Strip mid-point incidence - CHSIN = CHSINL + fc*(CHSINR-CHSINL) - CHCOS = CHCOSL + fc*(CHCOSR-CHCOSL) - AINC(idx_strip) = ATAN2(CHSIN,CHCOS) - - ! Set dv gains for incidence angles - ! Bring over the routine for this from make surf - DO N = 1, NDESIGN - CHSIN_G = (1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) - CHCOS_G = (1.0-FC)*CHCOSL_G(N) + FC*CHCOSR_G(N) - AINC_G(idx_strip,N) = (CHCOS*CHSIN_G - CHSIN*CHCOS_G) + ! Strip left side + idx_node = flatidx(1,idx_y,isurf) + idx_node_nx = flatidx(nx,idx_y,isurf) + do idx_dim = 1,3 + RLE1(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node) + end do + + CHORD1(idx_strip) = sqrt((mesh_surf(1,idx_node_nx) + & -mesh_surf(1,idx_node))**2 + (mesh_surf(3,idx_node_nx) + & -mesh_surf(3,idx_node))**2) + + ! Strip right side + idx_node_yp1 = flatidx(1,idx_y+1,isurf) + idx_node_nx_yp1 = flatidx(nx,idx_y+1,isurf) + do idx_dim = 1,3 + RLE2(idx_dim,idx_strip) = mesh_surf(idx_dim,idx_node_yp1) + end do + CHORD2(idx_strip) = sqrt((mesh_surf(1,idx_node_nx_yp1) + & -mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_nx_yp1) + & -mesh_surf(3,idx_node_yp1))**2) + + ! Strip mid-point + do idx_dim = 1,3 + ! Since the strips are linear SPANWISE we can just interpolate + RLE(idx_dim,idx_strip) = (RLE1(idx_dim,idx_strip) + & + RLE2(idx_dim,idx_strip))/2. + end do + ! The strips are not necessarily linear chord wise but by definition the chord value is + ! so we can interpolate + CHORD(idx_strip) = (CHORD1(idx_strip)+CHORD2(idx_strip))/2. + + ! Strip geometric incidence angle at the mid-point + ! This is strip incidence angle is computed from the LE and TE points + ! of the given geometry and is completely independent of AINC + ! This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isnt flattened + GINCSTRIP(idx_strip) = atan2(((mesh_surf(3,idx_node_nx) + & + mesh_surf(3,idx_node_nx_yp1))/2.- (mesh_surf(3,idx_node) + + & mesh_surf(3,idx_node_yp1))/2.), + & ((mesh_surf(1,idx_node_nx) + mesh_surf(1,idx_node_nx_yp1))/2. + & - (mesh_surf(1,idx_node) + mesh_surf(1,idx_node_yp1))/2.)) + + ! Strip width + m2 = mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_node) + m3 = mesh_surf(3,idx_node_yp1)-mesh_surf(3,idx_node) + WSTRIP(idx_strip) = sqrt(m2**2 + m3**2) + + ! Strip LE and TE sweep slopes + tanle(idx_strip) = (mesh_surf(1,idx_node_yp1) + & -mesh_surf(1,idx_node))/WSTRIP(idx_strip) + idx_node = flatidx(nx,idx_y,isurf) + idx_node_yp1 = flatidx(nx,idx_y+1,isurf) + tante(idx_strip) = (mesh_surf(1,idx_node_yp1) + & -mesh_surf(1,idx_node))/WSTRIP(idx_strip) + + ! Compute chord projections and strip twists + ! In AVL the AINCS are not interpolated. The chord projections are + ! So we have to replicate this effect. + + ! LINEAR interpolation over the strip: left, right, and midpoint + idx_nodel = flatidx(1,iptl,isurf) + idx_noder = flatidx(1,iptr,isurf) + + ! f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ + ! & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) + ! f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ + ! & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) + ! fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) + ! & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) + ! & -mesh_surf(2,idx_nodel)) + + ! the above expressions will always evaluate to the following for individual strips + f1 = 0.0 + f2 = 1.0 + fc = 0.5 + + ! Strip left side incidence + ! CHSIN = CHSINL + f1*(CHSINR-CHSINL) + ! CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) + AINC1(idx_strip) = ATAN2(CHSINL,CHCOSL) + + ! Strip right side incidence + ! CHSIN = CHSINL + f2*(CHSINR-CHSINL) + ! CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) + AINC2(idx_strip) = ATAN2(CHSINR,CHCOSR) + + ! Strip mid-point incidence + CHSIN = CHSINL + fc*(CHSINR-CHSINL) + CHCOS = CHCOSL + fc*(CHCOSR-CHCOSL) + AINC(idx_strip) = ATAN2(CHSIN,CHCOS) + + ! Set dv gains for incidence angles + ! Bring over the routine for this from make surf + DO N = 1, NDESIGN + CHSIN_G = (1.0-FC)*CHSINL_G(N) + FC*CHSINR_G(N) + CHCOS_G = (1.0-FC)*CHCOSL_G(N) + FC*CHCOSR_G(N) + AINC_G(idx_strip,N) = (CHCOS*CHSIN_G - CHSIN*CHCOS_G) & / (CHSIN**2 + CHCOS**2) - ENDDO + ENDDO - ! We have to now setup any control surfaces we defined for this strip - ! Bring over the routine for this from makesurf but modified for a strip - DO N = 1, NCONTROL - ICL = ISCONL(N) - ICR = ISCONR(N) + ! We have to now setup any control surfaces we defined for this strip + ! Bring over the routine for this from makesurf but modified for a strip + DO N = 1, NCONTROL + ICL = ISCONL(N) + ICR = ISCONR(N) - IF(ICL.EQ.0 .OR. ICR.EQ.0) THEN - ! no control effect here - GAINDA(N) = 0. - XLED(N) = 0. - XTED(N) = 0. + IF(ICL.EQ.0 .OR. ICR.EQ.0) THEN + ! no control effect here + GAINDA(N) = 0. + XLED(N) = 0. + XTED(N) = 0. - VHINGE(1,idx_strip,N) = 0. - VHINGE(2,idx_strip,N) = 0. - VHINGE(3,idx_strip,N) = 0. + VHINGE(1,idx_strip,N) = 0. + VHINGE(2,idx_strip,N) = 0. + VHINGE(3,idx_strip,N) = 0. - VREFL(idx_strip,N) = 0. + VREFL(idx_strip,N) = 0. - PHINGE(1,idx_strip,N) = 0. - PHINGE(2,idx_strip,N) = 0. - PHINGE(3,idx_strip,N) = 0. + PHINGE(1,idx_strip,N) = 0. + PHINGE(2,idx_strip,N) = 0. + PHINGE(3,idx_strip,N) = 0. - ELSE - ! control variable # N is active here - GAINDA(N) = GAIND(ICL,iptl ,isurf)*(1.0-FC) + ELSE + ! control variable # N is active here + GAINDA(N) = GAIND(ICL,iptl ,isurf)*(1.0-FC) & + GAIND(ICR,iptr,isurf)* FC - ! SAB Note: This interpolation ensures that the hinge line is - ! is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware - ! A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord - XHD = CHORDL*XHINGED(ICL,iptl ,isurf)*(1.0-FC) + ! SAB Note: This interpolation ensures that the hinge line is + ! is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware + ! A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord + XHD = CHORDL*XHINGED(ICL,iptl ,isurf)*(1.0-FC) & + CHORDR*XHINGED(ICR,iptr,isurf)* FC - IF(XHD.GE.0.0) THEN - ! TE control surface, with hinge at XHD - XLED(N) = XHD - XTED(N) = CHORD(idx_strip) - ELSE - ! LE control surface, with hinge at -XHD - XLED(N) = 0.0 - XTED(N) = -XHD - ENDIF + IF(XHD.GE.0.0) THEN + ! TE control surface, with hinge at XHD + XLED(N) = XHD + XTED(N) = CHORD(idx_strip) + ELSE + ! LE control surface, with hinge at -XHD + XLED(N) = 0.0 + XTED(N) = -XHD + ENDIF - VHX = VHINGED(1,ICL,iptl,isurf)*XYZSCAL(1,isurf) - VHY = VHINGED(2,ICL,iptl,isurf)*XYZSCAL(2,isurf) - VHZ = VHINGED(3,ICL,iptl,isurf)*XYZSCAL(3,isurf) - VSQ = VHX**2 + VHY**2 + VHZ**2 - IF(VSQ.EQ.0.0) THEN - ! default: set hinge vector along hingeline - ! We are just setting the hinge line across the section - ! this assumes the hinge is linear even for a nonlinear wing - VHX = mesh_surf(1,idx_noder) + VHX = VHINGED(1,ICL,iptl,isurf)*XYZSCAL(1,isurf) + VHY = VHINGED(2,ICL,iptl,isurf)*XYZSCAL(2,isurf) + VHZ = VHINGED(3,ICL,iptl,isurf)*XYZSCAL(3,isurf) + VSQ = VHX**2 + VHY**2 + VHZ**2 + IF(VSQ.EQ.0.0) THEN + ! default: set hinge vector along hingeline + ! We are just setting the hinge line across the section + ! this assumes the hinge is linear even for a nonlinear wing + VHX = mesh_surf(1,idx_noder) & + ABS(CHORDR*XHINGED(ICR,iptr,isurf)) & - mesh_surf(1,idx_nodel) & - ABS(CHORDL*XHINGED(ICL,iptl,isurf)) - VHY = mesh_surf(2,idx_noder) + VHY = mesh_surf(2,idx_noder) & - mesh_surf(2,idx_nodel) - VHZ = mesh_surf(3,idx_noder) + VHZ = mesh_surf(3,idx_noder) & - mesh_surf(3,idx_nodel) - VHX = VHX*XYZSCAL(1,isurf) - VHY = VHY*XYZSCAL(2,isurf) - VHZ = VHZ*XYZSCAL(3,isurf) - VSQ = VHX**2 + VHY**2 + VHZ**2 - ENDIF + VHX = VHX*XYZSCAL(1,isurf) + VHY = VHY*XYZSCAL(2,isurf) + VHZ = VHZ*XYZSCAL(3,isurf) + VSQ = VHX**2 + VHY**2 + VHZ**2 + ENDIF - VMOD = SQRT(VSQ) - VHINGE(1,idx_strip,N) = VHX/VMOD - VHINGE(2,idx_strip,N) = VHY/VMOD - VHINGE(3,idx_strip,N) = VHZ/VMOD + VMOD = SQRT(VSQ) + VHINGE(1,idx_strip,N) = VHX/VMOD + VHINGE(2,idx_strip,N) = VHY/VMOD + VHINGE(3,idx_strip,N) = VHZ/VMOD - VREFL(idx_strip,N) = REFLD(ICL,iptl, isurf) + VREFL(idx_strip,N) = REFLD(ICL,iptl, isurf) - IF(XHD .GE. 0.0) THEN - PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD - PHINGE(2,idx_strip,N) = RLE(2,idx_strip) - PHINGE(3,idx_strip,N) = RLE(3,idx_strip) - ELSE - PHINGE(1,idx_strip,N) = RLE(1,idx_strip) - XHD - PHINGE(2,idx_strip,N) = RLE(2,idx_strip) - PHINGE(3,idx_strip,N) = RLE(3,idx_strip) - ENDIF - ENDIF - ENDDO - - ! Interpolate CD-CL polar defining data from input to strips - DO idx_coef = 1, 6 - CLCD(idx_coef,idx_strip) = (1.0-fc)* - & CLCDSEC(idx_coef,iptl,isurf) + - & fc*CLCDSEC(idx_coef,iptr,isurf) - END DO - ! If the min drag is zero flag the strip as no-viscous data - LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) + IF(XHD .GE. 0.0) THEN + PHINGE(1,idx_strip,N) = RLE(1,idx_strip) + XHD + PHINGE(2,idx_strip,N) = RLE(2,idx_strip) + PHINGE(3,idx_strip,N) = RLE(3,idx_strip) + ELSE + PHINGE(1,idx_strip,N) = RLE(1,idx_strip) - XHD + PHINGE(2,idx_strip,N) = RLE(2,idx_strip) + PHINGE(3,idx_strip,N) = RLE(3,idx_strip) + ENDIF + ENDIF + ENDDO + + ! Interpolate CD-CL polar defining data from input to strips + DO idx_coef = 1, 6 + CLCD(idx_coef,idx_strip) = (1.0-fc)* + & CLCDSEC(idx_coef,iptl,isurf) + + & fc*CLCDSEC(idx_coef,iptr,isurf) + END DO + ! If the min drag is zero flag the strip as no-viscous data + LVISCSTRP(idx_strip) = (CLCD(4,idx_strip).NE.0.0) - ! Set the panel (vortex) geometry data + ! Set the panel (vortex) geometry data - ! Accumulate the strip element indicies and start counting vorticies - if (idx_strip .eq. 1) then - IJFRST(idx_strip) = 1 - else - IJFRST(idx_strip) = IJFRST(idx_strip - 1) + - & NVSTRP(idx_strip - 1) - endif - idx_vor = IJFRST(idx_strip) - NVSTRP(idx_strip) = NVC(isurf) - - ! Associate the strip with the surface - LSSURF(idx_strip) = isurf + ! Accumulate the strip element indicies and start counting vorticies + if (idx_strip .eq. 1) then + IJFRST(idx_strip) = 1 + else + IJFRST(idx_strip) = IJFRST(idx_strip - 1) + + & NVSTRP(idx_strip - 1) + endif + idx_vor = IJFRST(idx_strip) + NVSTRP(idx_strip) = NVC(isurf) - ! Prepare for cross section interpolation - NSL = NASEC(iptl , isurf) - NSR = NASEC(iptr, isurf) + ! Associate the strip with the surface + LSSURF(idx_strip) = isurf - ! CHORDC = CHORD(idx_strip) + ! Prepare for cross section interpolation + NSL = NASEC(iptl , isurf) + NSR = NASEC(iptr, isurf) + ! CHORDC = CHORD(idx_strip) - ! Funny story. this original line is now valid now that we interpolate over the strip - clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL - & + FC *(CHORDR/CHORD(idx_strip))*CLAFR - ! Suggestion from Hal Yougren for non linear sections: - ! clafc = (1.-fc)*clafl + fc*clafr - ! loop over vorticies for the strip - do idx_x = 1, nvc(isurf) - - ! Left bound vortex points - idx_node = flatidx(idx_x,idx_y,isurf) - ! Compute the panel left side chord - dc1 = sqrt((mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))**2 - & + (mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node))**2) - - if (LMESHFLAT(isurf)) then - ! Place vortex at panel quarter chord of the flat mesh - dx1 = sqrt((mesh_surf(1,idx_node) - RLE1(1,idx_strip))**2 - & + (mesh_surf(3,idx_node) - RLE1(3,idx_strip))**2) - RV1(2,idx_vor) = RLE1(2,idx_strip) - RV1(3,idx_vor) = RLE1(3,idx_strip) - RV1(1,idx_vor) = RLE1(1,idx_strip) + dx1 + (dc1/4.) - - ! Compute the panel left side angle - a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), - & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) - ! Place vortex at panel quarter chord of the true mesh - RV1MSH(2,idx_vor) = mesh_surf(2,idx_node) - RV1MSH(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) - RV1MSH(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) - else - ! Compute the panel left side angle - a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), - & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) - ! Place vortex at panel quarter chord - RV1(2,idx_vor) = mesh_surf(2,idx_node) - RV1(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) - RV1(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) - - ! Make a copy in the true mesh array for post processing - RV1MSH(2,idx_vor) = RV1(2,idx_vor) - RV1MSH(1,idx_vor) = RV1(1,idx_vor) - RV1MSH(3,idx_vor) = RV1(3,idx_vor) - end if + ! Funny story. this original line is now valid now that we interpolate over the strip + clafc = (1.-FC)*(CHORDL/CHORD(idx_strip))*CLAFL + & + FC *(CHORDR/CHORD(idx_strip))*CLAFR + ! Suggestion from Hal Yougren for non linear sections: + ! clafc = (1.-fc)*clafl + fc*clafr - ! Right bound vortex points - idx_node_yp1 = flatidx(idx_x,idx_y+1,isurf) - ! Compute the panel right side chord - dc2 = sqrt((mesh_surf(1,idx_node_yp1+1) - & - mesh_surf(1,idx_node_yp1))**2 + (mesh_surf(3,idx_node_yp1+1) - & - mesh_surf(3,idx_node_yp1))**2) - - if (LMESHFLAT(isurf)) then - ! Place vortex at panel quarter chord of the flat mesh - dx2 = sqrt((mesh_surf(1,idx_node_yp1) - RLE2(1,idx_strip))**2 - & + (mesh_surf(3,idx_node_yp1) - RLE2(3,idx_strip))**2) - RV2(2,idx_vor) = RLE2(2,idx_strip) - RV2(3,idx_vor) = RLE2(3,idx_strip) - RV2(1,idx_vor) = RLE2(1,idx_strip) + dx2 + (dc2/4.) - - ! Compute the panel right side angle - a2 = atan2((mesh_surf(3,idx_node_yp1+1) - - & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - - & mesh_surf(1,idx_node_yp1))) - ! Place vortex at panel quarter chord of the true mesh - RV2MSH(2,idx_vor) = mesh_surf(2,idx_node_yp1) - RV2MSH(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) - RV2MSH(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) - else - ! Compute the panel right side angle - a2 = atan2((mesh_surf(3,idx_node_yp1+1) - - & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - - & mesh_surf(1,idx_node_yp1))) - ! Place vortex at panel quarter chord - RV2(2,idx_vor) = mesh_surf(2,idx_node_yp1) - RV2(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) - RV2(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) - - ! Make a copy in the true mesh array for post processing - RV2MSH(2,idx_vor) = RV2(2,idx_vor) - RV2MSH(1,idx_vor) = RV2(1,idx_vor) - RV2MSH(3,idx_vor) = RV2(3,idx_vor) - end if + ! loop over vorticies for the strip + do idx_x = 1, nvc(isurf) + + ! Left bound vortex points + idx_node = flatidx(idx_x,idx_y,isurf) + ! Compute the panel left side chord + dc1 = sqrt((mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))**2 + & + (mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node))**2) + + if (LMESHFLAT(isurf)) then + ! Place vortex at panel quarter chord of the flat mesh + dx1 = sqrt((mesh_surf(1,idx_node) - RLE1(1,idx_strip))**2 + & + (mesh_surf(3,idx_node) - RLE1(3,idx_strip))**2) + RV1(2,idx_vor) = RLE1(2,idx_strip) + RV1(3,idx_vor) = RLE1(3,idx_strip) + RV1(1,idx_vor) = RLE1(1,idx_strip) + dx1 + (dc1/4.) + + ! Compute the panel left side angle + a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), + & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) + ! Place vortex at panel quarter chord of the true mesh + RV1MSH(2,idx_vor) = mesh_surf(2,idx_node) + RV1MSH(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) + RV1MSH(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) + else + ! Compute the panel left side angle + a1 = atan2((mesh_surf(3,idx_node+1) - mesh_surf(3,idx_node)), + & (mesh_surf(1,idx_node+1) - mesh_surf(1,idx_node))) + ! Place vortex at panel quarter chord + RV1(2,idx_vor) = mesh_surf(2,idx_node) + RV1(1,idx_vor) = mesh_surf(1,idx_node) + (dc1/4.)*cos(a1) + RV1(3,idx_vor) = mesh_surf(3,idx_node) + (dc1/4.)*sin(a1) + + ! Make a copy in the true mesh array for post processing + RV1MSH(2,idx_vor) = RV1(2,idx_vor) + RV1MSH(1,idx_vor) = RV1(1,idx_vor) + RV1MSH(3,idx_vor) = RV1(3,idx_vor) + end if + + ! Right bound vortex points + idx_node_yp1 = flatidx(idx_x,idx_y+1,isurf) + ! Compute the panel right side chord + dc2 = sqrt((mesh_surf(1,idx_node_yp1+1) + & - mesh_surf(1,idx_node_yp1))**2 + & + (mesh_surf(3,idx_node_yp1+1) + & - mesh_surf(3,idx_node_yp1))**2) + + if (LMESHFLAT(isurf)) then + ! Place vortex at panel quarter chord of the flat mesh + dx2 = sqrt((mesh_surf(1,idx_node_yp1) - RLE2(1,idx_strip))**2 + & + (mesh_surf(3,idx_node_yp1) - RLE2(3,idx_strip))**2) + + RV2(2,idx_vor) = RLE2(2,idx_strip) + RV2(3,idx_vor) = RLE2(3,idx_strip) + RV2(1,idx_vor) = RLE2(1,idx_strip) + dx2 + (dc2/4.) + + ! Compute the panel right side angle + a2 = atan2((mesh_surf(3,idx_node_yp1+1) + & - mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) + & - mesh_surf(1,idx_node_yp1))) + ! Place vortex at panel quarter chord of the true mesh + RV2MSH(2,idx_vor) = mesh_surf(2,idx_node_yp1) + RV2MSH(1,idx_vor) = mesh_surf(1,idx_node_yp1) + & + (dc2/4.)*cos(a2) + RV2MSH(3,idx_vor) = mesh_surf(3,idx_node_yp1) + & + (dc2/4.)*sin(a2) + else + ! Compute the panel right side angle + a2 = atan2((mesh_surf(3,idx_node_yp1+1) - + & mesh_surf(3,idx_node_yp1)), (mesh_surf(1,idx_node_yp1+1) - + & mesh_surf(1,idx_node_yp1))) + ! Place vortex at panel quarter chord + RV2(2,idx_vor) = mesh_surf(2,idx_node_yp1) + RV2(1,idx_vor) = mesh_surf(1,idx_node_yp1) + (dc2/4.)*cos(a2) + RV2(3,idx_vor) = mesh_surf(3,idx_node_yp1) + (dc2/4.)*sin(a2) + + ! Make a copy in the true mesh array for post processing + RV2MSH(2,idx_vor) = RV2(2,idx_vor) + RV2MSH(1,idx_vor) = RV2(1,idx_vor) + RV2MSH(3,idx_vor) = RV2(3,idx_vor) + end if - ! Mid-point bound vortex points - ! Compute the panel mid-point chord - ! Panels themselves can never be curved so just interpolate the chord - ! store as the panel chord in common block - DXV(idx_vor) = (dc1+dc2)/2. - ! We need to compute the midpoint angle and panel strip chord projection - ! as we need them to compute normals based on the real mesh - a3 = atan2(((mesh_surf(3,idx_node_yp1+1) - & + mesh_surf(3,idx_node+1))/2.- (mesh_surf(3,idx_node_yp1) + - & mesh_surf(3,idx_node))/2.), - & ((mesh_surf(1,idx_node_yp1+1) + mesh_surf(1,idx_node+1))/2. - & - (mesh_surf(1,idx_node_yp1) + mesh_surf(1,idx_node))/2.)) + ! Mid-point bound vortex points + ! Compute the panel mid-point chord + ! Panels themselves can never be curved so just interpolate the chord + ! store as the panel chord in common block + DXV(idx_vor) = (dc1+dc2)/2. + ! We need to compute the midpoint angle and panel strip chord projection + ! as we need them to compute normals based on the real mesh + a3 = atan2(((mesh_surf(3,idx_node_yp1+1) + & + mesh_surf(3,idx_node+1))/2.- (mesh_surf(3,idx_node_yp1) + + & mesh_surf(3,idx_node))/2.), + & ((mesh_surf(1,idx_node_yp1+1) + mesh_surf(1,idx_node+1))/2. + & - (mesh_surf(1,idx_node_yp1) + mesh_surf(1,idx_node))/2.)) ! project the panel chord onto the strip chord - DXSTRPV(idx_vor) = DXV(idx_vor)*cos(a3-GINCSTRIP(idx_strip)) + DXSTRPV(idx_vor) = DXV(idx_vor)*cos(a3-GINCSTRIP(idx_strip)) - if (LMESHFLAT(isurf)) then - ! Place vortex at panel quarter chord of the flat mesh - dx3 = sqrt(((mesh_surf(1,idx_node_yp1)+mesh_surf(1,idx_node))/2 + if (LMESHFLAT(isurf)) then + ! Place vortex at panel quarter chord of the flat mesh + dx3 = sqrt(((mesh_surf(1,idx_node_yp1)+mesh_surf(1,idx_node))/2 & - RLE(1,idx_strip))**2 - & + ((mesh_surf(3,idx_node_yp1)+mesh_surf(3,idx_node))/2 + & + ((mesh_surf(3,idx_node_yp1)+mesh_surf(3,idx_node))/2 & - RLE(3,idx_strip))**2) - RV(2,idx_vor) = RLE(2,idx_strip) - RV(3,idx_vor) = RLE(3,idx_strip) - RV(1,idx_vor) = RLE(1,idx_strip) + dx3 + (DXV(idx_vor)/4.) - - ! Place vortex at panel quarter chord of the true mesh - RVMSH(2,idx_vor) = (mesh_surf(2,idx_node_yp1) - & + mesh_surf(2,idx_node))/2. - RVMSH(1,idx_vor) = (mesh_surf(1,idx_node_yp1) - & +mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) - RVMSH(3,idx_vor) = (mesh_surf(3,idx_node_yp1) - & +mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) - else - ! Place vortex at panel quarter chord - RV(2,idx_vor) = (mesh_surf(2,idx_node_yp1) - & + mesh_surf(2,idx_node))/2. - RV(1,idx_vor) = (mesh_surf(1,idx_node_yp1) - & +mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) - RV(3,idx_vor) = (mesh_surf(3,idx_node_yp1) - & +mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) - - ! Make a copy in the true mesh array for post processing - RVMSH(2,idx_vor) = RV(2,idx_vor) - RVMSH(1,idx_vor) = RV(1,idx_vor) - RVMSH(3,idx_vor) = RV(3,idx_vor) - end if + RV(2,idx_vor) = RLE(2,idx_strip) + RV(3,idx_vor) = RLE(3,idx_strip) + RV(1,idx_vor) = RLE(1,idx_strip) + dx3 + (DXV(idx_vor)/4.) + + ! Place vortex at panel quarter chord of the true mesh + RVMSH(2,idx_vor) = (mesh_surf(2,idx_node_yp1) + & + mesh_surf(2,idx_node))/2. + RVMSH(1,idx_vor) = (mesh_surf(1,idx_node_yp1) + & + mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) + RVMSH(3,idx_vor) = (mesh_surf(3,idx_node_yp1) + & + mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) + else + ! Place vortex at panel quarter chord + RV(2,idx_vor) = (mesh_surf(2,idx_node_yp1) + & + mesh_surf(2,idx_node))/2. + RV(1,idx_vor) = (mesh_surf(1,idx_node_yp1) + & + mesh_surf(1,idx_node))/2.+ (DXV(idx_vor)/4.)*cos(a3) + RV(3,idx_vor) = (mesh_surf(3,idx_node_yp1) + & + mesh_surf(3,idx_node))/2. + (DXV(idx_vor)/4.)*sin(a3) + + ! Make a copy in the true mesh array for post processing + RVMSH(2,idx_vor) = RV(2,idx_vor) + RVMSH(1,idx_vor) = RV(1,idx_vor) + RVMSH(3,idx_vor) = RV(3,idx_vor) + end if - ! Panel Control points - ! Y- point - ! is just the panel midpoint - RC(2,idx_vor) = RV(2,idx_vor) - ! Place the control point at the quarter chord + half chord*clafc - ! note that clafc is a scaler so is 1. is for 2pi - ! use data from vortex mid-point computation - if (LMESHFLAT(isurf)) then - RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.) - RC(3,idx_vor) = RV(3,idx_vor) - - RCMSH(1,idx_vor) = RVMSH(1,idx_vor) - & + clafc*(DXV(idx_vor)/2.)*cos(a3) - RCMSH(3,idx_vor) = RVMSH(3,idx_vor) - & + clafc*(DXV(idx_vor)/2.)*sin(a3) - RCMSH(2,idx_vor) = RVMSH(2,idx_vor) - else - RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.)*cos(a3) - RC(3,idx_vor) = RV(3,idx_vor) + clafc*(DXV(idx_vor)/2.)*sin(a3) - - ! Make a copy in the true mesh array for post processing - RCMSH(1,idx_vor) = RC(1,idx_vor) - RCMSH(3,idx_vor) = RC(3,idx_vor) - RCMSH(2,idx_vor) = RC(2,idx_vor) - end if + ! Panel Control points + ! Y- point + ! is just the panel midpoint + RC(2,idx_vor) = RV(2,idx_vor) + ! Place the control point at the quarter chord + half chord*clafc + ! note that clafc is a scaler so is 1. is for 2pi + ! use data from vortex mid-point computation + if (LMESHFLAT(isurf)) then + RC(1,idx_vor) = RV(1,idx_vor) + clafc*(DXV(idx_vor)/2.) + RC(3,idx_vor) = RV(3,idx_vor) + + RCMSH(1,idx_vor) = RVMSH(1,idx_vor) + & + clafc*(DXV(idx_vor)/2.)*cos(a3) + RCMSH(3,idx_vor) = RVMSH(3,idx_vor) + & + clafc*(DXV(idx_vor)/2.)*sin(a3) + RCMSH(2,idx_vor) = RVMSH(2,idx_vor) + else + RC(1,idx_vor) = RV(1,idx_vor) + & + clafc*(DXV(idx_vor)/2.)*cos(a3) + RC(3,idx_vor) = RV(3,idx_vor) + & + clafc*(DXV(idx_vor)/2.)*sin(a3) + + ! Make a copy in the true mesh array for post processing + RCMSH(1,idx_vor) = RC(1,idx_vor) + RCMSH(3,idx_vor) = RC(3,idx_vor) + RCMSH(2,idx_vor) = RC(2,idx_vor) + end if - ! Source points - ! Y- point - RS(2,idx_vor) = RV(2,idx_vor) - ! Place the source point at the half chord - ! use data from vortex mid-point computation - ! add another quarter chord to the quarter chord - if (LMESHFLAT(isurf)) then - RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.) - RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.) - else - RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) - RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) - end if + ! Source points + ! Y- point + RS(2,idx_vor) = RV(2,idx_vor) + ! Place the source point at the half chord + ! use data from vortex mid-point computation + ! add another quarter chord to the quarter chord + if (LMESHFLAT(isurf)) then + RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.) + RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.) + else + RS(1,idx_vor) = RV(1,idx_vor) + (DXV(idx_vor)/4.)*cos(a3) + RS(3,idx_vor) = RV(3,idx_vor) + (DXV(idx_vor)/4.)*sin(a3) + end if - ! Set the camber slopes for the panel + ! Set the camber slopes for the panel - ! Camber slope at control point - CALL AKIMA(XASEC(1,iptl, isurf),SASEC(1,iptl, isurf), - & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,iptr,isurf),SASEC(1,iptr,isurf), - & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPER, DSDX) - - ! Alternative for nonlinear sections per Hal Youngren - ! SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER - ! The original line is valid for interpolation over a strip - SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + ! Camber slope at control point + CALL AKIMA(XASEC(1,iptl, isurf),SASEC(1,iptl, isurf), + & NSL,(RC(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPEL, DSDX) + CALL AKIMA(XASEC(1,iptr,isurf),SASEC(1,iptr,isurf), + & NSR,(RC(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPER, DSDX) + + ! Alternative for nonlinear sections per Hal Youngren + ! SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER + ! The original line is valid for interpolation over a strip + SLOPEC(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - ! Camber slope at vortex mid-point - CALL AKIMA(XASEC(1,iptl, isurf),SASEC(1,iptl, isurf), - & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPEL, DSDX) - CALL AKIMA(XASEC(1,iptr,isurf),SASEC(1,iptr,isurf), - & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) - & /CHORD(idx_strip),SLOPER, DSDX) - - ! Alternative for nonlinear sections per Hal Youngren - ! SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER - ! The original line is valid for interpolation over a strip - SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL - & + fc *(CHORDR/CHORD(idx_strip))*SLOPER - - ! Associate the panel with strip chord and component - CHORDV(idx_vor) = CHORD(idx_strip) - LVCOMP(idx_vor) = LNCOMP(isurf) - - ! Enforce no penetration at the control point - LVNC(idx_vor) = .true. - - ! element inherits alpha,beta flag from surface - LVALBE(idx_vor) = LFALBE(isurf) - - ! We need to scale the control surface gains by the fraction - ! of the element on the control surface - do N = 1, NCONTROL - !scale control gain by factor 0..1, (fraction of element on control surface) - xpt = ((mesh_surf(1,idx_node)+mesh_surf(1,idx_node_yp1)) - & /2 - RLE(1,idx_strip))/CHORD(idx_strip) - - FRACLE = (XLED(N)/CHORD(idx_strip)-xpt) / - & (DXV(idx_vor)/CHORD(idx_strip)) - - FRACTE = (XTED(N)/CHORD(idx_strip)-xpt) / - & (DXV(idx_vor)/CHORD(idx_strip)) - - FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) - FRACTE = MIN( 1.0 , MAX( 0.0 , FRACTE ) ) - - DCONTROL(idx_vor,N) = GAINDA(N)*(FRACTE-FRACLE) - end do - - ! TE control point used only if surface sheds a wake - LVNC(idx_vor) = LFWAKE(isurf) - - ! Use the cross sections to generate the OML - ! nodal grid associated with vortex strip (aft-panel nodes) - ! NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; - ! retained in (x,z) plane at this point - - ! Store the panel LE mid point for the next panel in the strip - ! This gets used a lot here - ! We use the original input mesh (true mesh) to compute points for the OML - xptxind1 = ((mesh_surf(1,idx_node+1)+mesh_surf(1,idx_node_yp1+1)) - & /2 - RLE(1,idx_strip))/CHORD(idx_strip) - -! xptxind2 = (mesh_surf(1,idx_node_yp1+1) -! & - RLE2(1,idx_strip))/CHORD2(idx_strip) - - ! Interpolate cross section on left side - CALL AKIMA( XLASEC(1,iptl,isurf), ZLASEC(1,iptl,isurf), - & NSL,xptxind1, ZL_L, DSDX ) - CALL AKIMA( XUASEC(1,iptl,isurf), ZUASEC(1,iptl,isurf), - & NSL,xptxind1, ZU_L, DSDX ) - - ! Interpolate cross section on right side - CALL AKIMA( XLASEC(1,iptr,isurf), - & ZLASEC(1,iptr,isurf),NSR, xptxind1, ZL_R, DSDX) - - CALL AKIMA( XUASEC(1,iptr,isurf), - & ZUASEC(1,iptr,isurf),NSR, xptxind1, ZU_R, DSDX) - - - ! Compute the left aft node of panel - ! X-point - XYN1(1,idx_vor) = RLE1(1,idx_strip) + - & xptxind1*CHORD1(idx_strip) + ! Camber slope at vortex mid-point + CALL AKIMA(XASEC(1,iptl, isurf),SASEC(1,iptl, isurf), + & NSL,(RV(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPEL, DSDX) + CALL AKIMA(XASEC(1,iptr,isurf),SASEC(1,iptr,isurf), + & NSR,(RV(1,idx_vor)-RLE(1,idx_strip)) + & /CHORD(idx_strip),SLOPER, DSDX) + + ! Alternative for nonlinear sections per Hal Youngren + ! SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER + ! The original line is valid for interpolation over a strip + SLOPEV(idx_vor) = (1.-fc)*(CHORDL/CHORD(idx_strip))*SLOPEL + & + fc *(CHORDR/CHORD(idx_strip))*SLOPER + + ! Associate the panel with strip chord and component + CHORDV(idx_vor) = CHORD(idx_strip) + LVCOMP(idx_vor) = LNCOMP(isurf) + + ! Enforce no penetration at the control point + LVNC(idx_vor) = .true. - ! Y-point - XYN1(2,idx_vor) = RLE1(2,idx_strip) + ! element inherits alpha,beta flag from surface + LVALBE(idx_vor) = LFALBE(isurf) - ! Interpolate z from sections to left aft node of panel - ZL = (1.-f1)*ZL_L + f1 *ZL_R - ZU = (1.-f1)*ZU_L + f1 *ZU_R + ! We need to scale the control surface gains by the fraction + ! of the element on the control surface + do N = 1, NCONTROL + !scale control gain by factor 0..1, (fraction of element on control surface) + xpt = ((mesh_surf(1,idx_node)+mesh_surf(1,idx_node_yp1))/2 + & - RLE(1,idx_strip))/CHORD(idx_strip) - ! Store left aft z-point - ZLON1(idx_vor) = RLE1(3,idx_strip) + ZL*CHORD1(idx_strip) - ZUPN1(idx_vor) = RLE1(3,idx_strip) + ZU*CHORD1(idx_strip) + FRACLE = (XLED(N)/CHORD(idx_strip)-xpt) / + & (DXV(idx_vor)/CHORD(idx_strip)) - ! Compute the right aft node of panel - ! X-point - XYN2(1,idx_vor) = RLE2(1,idx_strip) + - & xptxind1*CHORD2(idx_strip) + FRACTE = (XTED(N)/CHORD(idx_strip)-xpt) / + & (DXV(idx_vor)/CHORD(idx_strip)) - ! Y-point - XYN2(2,idx_vor) = RLE2(2,idx_strip) - - ! Interpolate z from sections to right aft node of panel - ZL = (1.-f2)*ZL_L + f2 *ZL_R - ZU = (1.-f2)*ZU_L + f2 *ZU_R + FRACLE = MIN( 1.0 , MAX( 0.0 , FRACLE ) ) + FRACTE = MIN( 1.0 , MAX( 0.0 , FRACTE ) ) - ! Store right aft z-point - ZLON2(idx_vor) = RLE2(3,idx_strip) + ZL*CHORD2(idx_strip) - ZUPN2(idx_vor) = RLE2(3,idx_strip) + ZU*CHORD2(idx_strip) + DCONTROL(idx_vor,N) = GAINDA(N)*(FRACTE-FRACLE) + end do + + ! TE control point used only if surface sheds a wake + LVNC(idx_vor) = LFWAKE(isurf) + + ! Use the cross sections to generate the OML + ! nodal grid associated with vortex strip (aft-panel nodes) + ! NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; + ! retained in (x,z) plane at this point + + ! Store the panel LE mid point for the next panel in the strip + ! This gets used a lot here + ! We use the original input mesh (true mesh) to compute points for the OML + xptxind1 = ((mesh_surf(1,idx_node+1) + & + mesh_surf(1,idx_node_yp1+1))/2 + & - RLE(1,idx_strip))/CHORD(idx_strip) + + ! xptxind2 = (mesh_surf(1,idx_node_yp1+1) + ! & - RLE2(1,idx_strip))/CHORD2(idx_strip) + + ! Interpolate cross section on left side + CALL AKIMA( XLASEC(1,iptl,isurf), ZLASEC(1,iptl,isurf), + & NSL,xptxind1, ZL_L, DSDX ) + CALL AKIMA( XUASEC(1,iptl,isurf), ZUASEC(1,iptl,isurf), + & NSL,xptxind1, ZU_L, DSDX ) + + ! Interpolate cross section on right side + CALL AKIMA(XLASEC(1,iptr,isurf), + & ZLASEC(1,iptr,isurf),NSR, xptxind1, ZL_R, DSDX) + + CALL AKIMA(XUASEC(1,iptr,isurf), + & ZUASEC(1,iptr,isurf),NSR, xptxind1, ZU_R, DSDX) + + + ! Compute the left aft node of panel + ! X-point + XYN1(1,idx_vor) = RLE1(1,idx_strip) + + & xptxind1*CHORD1(idx_strip) + + ! Y-point + XYN1(2,idx_vor) = RLE1(2,idx_strip) + + ! Interpolate z from sections to left aft node of panel + ZL = (1.-f1)*ZL_L + f1 *ZL_R + ZU = (1.-f1)*ZU_L + f1 *ZU_R + + ! Store left aft z-point + ZLON1(idx_vor) = RLE1(3,idx_strip) + ZL*CHORD1(idx_strip) + ZUPN1(idx_vor) = RLE1(3,idx_strip) + ZU*CHORD1(idx_strip) + + ! Compute the right aft node of panel + ! X-point + XYN2(1,idx_vor) = RLE2(1,idx_strip) + + & xptxind1*CHORD2(idx_strip) + + ! Y-point + XYN2(2,idx_vor) = RLE2(2,idx_strip) + + ! Interpolate z from sections to right aft node of panel + ZL = (1.-f2)*ZL_L + f2 *ZL_R + ZU = (1.-f2)*ZU_L + f2 *ZU_R + + ! Store right aft z-point + ZLON2(idx_vor) = RLE2(3,idx_strip) + ZL*CHORD2(idx_strip) + ZUPN2(idx_vor) = RLE2(3,idx_strip) + ZU*CHORD2(idx_strip) - idx_vor = idx_vor + 1 - end do ! End vortex loop + idx_vor = idx_vor + 1 + end do ! End vortex loop idx_strip = idx_strip + 1 end do ! End strip loop @@ -2011,34 +2020,34 @@ SUBROUTINE ENCALC ! Since we cannot seperate the encalc routine for direct mesh assignment we have to make it a branch here if (lsurfmsh(lssurf(J))) then - ! Calculate normal vector for the strip (normal to X axis) - ! we can't just interpolate this anymore given that - ! the strip is no longer necessarily linear chordwise - - ! We want the spanwise unit vector for the strip at the - ! chordwise location specified by SAXFR (usually set to 0.25) - ! Loop over all panels in the strip until we find the one that contains - ! the SAXFR position in it's projected chord. Since the panels themselves are still linear - ! we can just use the bound vortex unit vector of that panel as - ! the spanwise unit vector of the strip at SAXFR - - ! SAB: This is slow, find a better way to do this - dchstrip = 0.0 - searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) - dchstrip = dchstrip+DXSTRPV(i) - if (dchstrip .ge. CHORD(J)*SAXFR) then - exit searchSAXFR - end if - end do searchSAXFR - - - ! compute the spanwise unit vector for Vperp def - DXT = RV2MSH(1,I)-RV1MSH(1,I) - DYT = RV2MSH(2,I)-RV1MSH(2,I) - DZT = RV2MSH(3,I)-RV1MSH(3,I) - XSREF(J) = RVMSH(1,I) - YSREF(J) = RVMSH(2,I) - ZSREF(J) = RVMSH(3,I) + ! Calculate normal vector for the strip (normal to X axis) + ! we can't just interpolate this anymore given that + ! the strip is no longer necessarily linear chordwise + + ! We want the spanwise unit vector for the strip at the + ! chordwise location specified by SAXFR (usually set to 0.25) + ! Loop over all panels in the strip until we find the one that contains + ! the SAXFR position in it's projected chord. Since the panels themselves are still linear + ! we can just use the bound vortex unit vector of that panel as + ! the spanwise unit vector of the strip at SAXFR + + ! SAB: This is slow, find a better way to do this + dchstrip = 0.0 + searchSAXFR: do i = IJFRST(J),IJFRST(J) + (NVSTRP(J)-1) + dchstrip = dchstrip+DXSTRPV(i) + if (dchstrip .ge. CHORD(J)*SAXFR) then + exit searchSAXFR + end if + end do searchSAXFR + + + ! compute the spanwise unit vector for Vperp def + DXT = RV2MSH(1,I)-RV1MSH(1,I) + DYT = RV2MSH(2,I)-RV1MSH(2,I) + DZT = RV2MSH(3,I)-RV1MSH(3,I) + XSREF(J) = RVMSH(1,I) + YSREF(J) = RVMSH(2,I) + ZSREF(J) = RVMSH(3,I) else ! original encalc routine for standard AVL geometry @@ -2152,7 +2161,7 @@ SUBROUTINE ENCALC if (lsurfmsh(lssurf(J))) then ! direct mesh assignemnt branch ! now we compute the chordwise panel vector - ! note that panel's chordwise vector has contributions + ! note that panel`s chordwise vector has contributions ! from both the geometry itself and the incidence modification ! from the AVL AINC and camber slope variables From 191b0d24dc257536393c7142cdb95ddf2d378625 Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Sun, 8 Feb 2026 02:18:51 -0500 Subject: [PATCH 36/49] fixed EC_G for custom meshes --- src/amake.f | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/amake.f b/src/amake.f index 44efd5d..c0e06df 100644 --- a/src/amake.f +++ b/src/amake.f @@ -2209,13 +2209,13 @@ SUBROUTINE ENCALC ! Note the derivative is only wrt to AVL incidence vars ! as those are the vars AVL DVs can support if (lsurfmsh(lssurf(J))) then - EC(1) = -SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) - & + ES(3)*COSC*ec_msh(3) - EC(2) = -ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC)*ec_msh(2) - & - (ES(2)*ES(3)*(1+SINC))*ec_msh(3) - EC(3) = -ES(3)*COSC*ec_msh(1) - + EC_G(1,N) = (-SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) + & + ES(3)*COSC*ec_msh(3))*AINC_G(J,N) + EC_G(2,N) = (-ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC) + & *ec_msh(2) - (ES(2)*ES(3)*(1+SINC))*ec_msh(3))*AINC_G(J,N) + EC_G(3,N) = (-ES(3)*COSC*ec_msh(1) - & (ES(2)*ES(3)*(1+SINC))*ec_msh(2) + - & ((ES(2)**2)*(1+SINC) - SINC)*ec_msh(3) + & ((ES(2)**2)*(1+SINC) - SINC)*ec_msh(3))*AINC_G(J,N) else EC_G(1,N) = -SINC *AINC_G(J,N) @@ -2286,13 +2286,13 @@ SUBROUTINE ENCALC DO N = 1, NDESIGN if (lsurfmsh(lssurf(J))) then ! Direct mesh assignment branch - EC(1) = -SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) - & + ES(3)*COSC*ec_msh(3) - EC(2) = -ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC)*ec_msh(2) - & - (ES(2)*ES(3)*(1+SINC))*ec_msh(3) - EC(3) = -ES(3)*COSC*ec_msh(1) - + EC_G(1,N) = (-SINC*ec_msh(1) + ES(2)*COSC*ec_msh(2) + & + ES(3)*COSC*ec_msh(3))*AINC_G(J,N) + EC_G(2,N) = (-ES(2)*COSC + ((ES(3)**2)*(1+SINC)-SINC) + & *ec_msh(2) - (ES(2)*ES(3)*(1+SINC))*ec_msh(3))*AINC_G(J,N) + EC_G(3,N) = (-ES(3)*COSC*ec_msh(1) - & (ES(2)*ES(3)*(1+SINC))*ec_msh(2) + - & ((ES(2)**2)*(1+SINC) - SINC)*ec_msh(3) + & ((ES(2)**2)*(1+SINC) - SINC)*ec_msh(3))*AINC_G(J,N) else EC_G(1,N) = -SINC *AINC_G(J,N) From c00f256594b7ca7b1b7ac51776ee5de1d717dcfd Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 9 Feb 2026 15:34:47 -0500 Subject: [PATCH 37/49] Added a unit test --- optvl/utils/check_surface_dict.py | 6 +- tests/test_mesh_input.py | 256 ++++++++++++++++++++++++++++++ tests/wing_mesh.npy | Bin 0 -> 1976 bytes 3 files changed, 259 insertions(+), 3 deletions(-) create mode 100644 tests/test_mesh_input.py create mode 100644 tests/wing_mesh.npy diff --git a/optvl/utils/check_surface_dict.py b/optvl/utils/check_surface_dict.py index 7ecd3aa..89cfb0b 100755 --- a/optvl/utils/check_surface_dict.py +++ b/optvl/utils/check_surface_dict.py @@ -129,7 +129,7 @@ def pre_check_input_dict(input_dict: dict): "use surface spacing", # surface spacing set under the surface heeading (known as LSURFSPACING in AVL) # Geometery: Mesh "mesh", - "flatten_mesh", + "flatten mesh", # Control Surfaces "control_assignments", "icontd", # control variable index @@ -256,7 +256,7 @@ def pre_check_input_dict(input_dict: dict): raise RuntimeError("Must have at least two sections per surface!") # Read and process the controls dictionary - if "control_assignments" in input_dict["surfaces"][surface]: + if "control_assignments" in input_dict["surfaces"][surface] and "num_controls" not in input_dict["surfaces"][surface]: num_controls_per_sec = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) for control in input_dict["surfaces"][surface]["control_assignments"]: @@ -293,7 +293,7 @@ def pre_check_input_dict(input_dict: dict): input_dict["surfaces"][surface]["num_controls"] = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) # Read and process the design variables dictionary - if "design_var_assignments" in input_dict["surfaces"][surface]: + if "design_var_assignments" in input_dict["surfaces"][surface] and "num_design_vars" not in input_dict["surfaces"][surface]: num_design_vars_per_sec = np.zeros(input_dict["surfaces"][surface]["num_sections"],dtype=np.int32) for design_var in input_dict["surfaces"][surface]["design_var_assignments"]: diff --git a/tests/test_mesh_input.py b/tests/test_mesh_input.py new file mode 100644 index 0000000..8c62c6d --- /dev/null +++ b/tests/test_mesh_input.py @@ -0,0 +1,256 @@ +# ============================================================================= +# Extension modules +# ============================================================================= +from optvl import OVLSolver + +# ============================================================================= +# Standard Python Modules +# ============================================================================= +import os +from copy import deepcopy + +# ============================================================================= +# External Python modules +# ============================================================================= +import unittest +import numpy as np + + + +mesh = np.load("wing_mesh.npy") + +surf = { + "Wing": { + # General + "component": np.int32(1), # logical surface component index (for grouping interacting surfaces, see AVL manual) + "yduplicate": np.float64(0.0), # surface is duplicated over the ysymm plane + # "wake": np.int32( + # 1 + # ), # specifies that this surface is to NOT shed a wake, so that its strips will not have their Kutta conditions imposed + # "albe": np.int32( + # 1 + # ), # specifies that this surface is unaffected by freestream direction changes specified by the alpha,beta angles and p,q,r rotation rates + # "load": np.int32( + # 1 + # ), # specifies that the force and moment on this surface is to NOT be included in the overall forces and moments of the configuration + # "clcdsec": np.array( + # [0.0, 0.0, 0.0, 0.0, 0.0, 0.0] + # ), # profile-drag CD(CL) function for each section in this surface (provide a single entry and OptVL applies to all strips, otherwise provide a vector corresponding to each strip) + # "cdcl": np.array( + # [0.0, 0.0, 0.0, 0.0, 0.0, 0.0] + # ), # profile-drag CD(CL) function for all sections in this surface, overrides Tahnks. + "claf": 1.0, # CL alpha (dCL/da) scaling factor per section (provide a single entry and OptVL applies to all strips, otherwise provide a vector corresponding to each strip) + + # Geometry + "scale": np.array( + [1.0, 1.0, 1.0], dtype=np.float64 + ), # scaling factors applied to all x,y,z coordinates (chords arealso scaled by Xscale) + "translate": np.array( + [0.0, 0.0, 0.0], dtype=np.float64 + ), # offset added on to all X,Y,Z values in this surface + "angle": np.float64(0.0), # offset added on to the Ainc values for all the defining sections in this surface + "aincs": np.ones(mesh.shape[1]), # incidence angle vector (provide a single entry and OptVL applies to all strips, otherwise provide a vector corresponding to each strip) + + # Geometry: Mesh + "mesh": np.float64(mesh), # (nx,ny,3) numpy array containing mesh coordinates + "flatten mesh": True, # True by default so can be turned off or just excluded (not recommended) + + # Geometry: Cross Sections (provide a single entry and OptVL applies to all strips, otherwise provide a vector corresponding to each strip) + # "xfminmax": np.array([[0.0, 1.0]]), # airfoil x/c limits + # NACA + # 'naca' : '2412', # 4-digit NACA airfoil + # Direct Assignment of camberline/thickness + # 'xasec': np.array([[0., 1.]]), # the x coordinate aifoil section + # 'casec': np.array([[0., 0.]]), # camber line at xasec + # 'tasec': np.array([[0., 0.]]), # thickness at xasec + # 'xuasec': np.array([[0., 0.]]), # airfoil upper surface x-coords (alternative to specifying camber line) + # 'xlasec': np.array([[0., 0.]]), # airfoil lower surface x-coords (alternative to specifying camber line) + # 'zuasec': np.array([[0., 0.]]), # airfoil upper surface z-coords (alternative to specifying camber line) + # 'zlasec': np.array([[0., 0.]]), # airfoil lower surface z-coords (alternative to specifying camber line) + # Airfoil Files + 'afiles': 'airfoils/ag40d.dat', # airfoil file names + + + # Control Surface Specification + "control_assignments": { + "flap" : {"assignment":np.arange(0,mesh.shape[1]), + "xhinged": 0.8, # x/c location of hinge + "vhinged": np.zeros(3), # vector giving hinge axis about which surface rotates + "gaind": 1.0, # control surface gain + "refld": 1.0 # control surface reflection, sign of deflection for duplicated surface + } + }, + + # Design Variables (AVL) Specification + "design_var_assignments": { + "des" : {"assignment":np.arange(0,mesh.shape[1]), + "gaing":1.0} + }, + } +} + + +surf_avl = { + "Wing": { + # General + "num_sections": np.int32(2), + "component": np.int32(1), # logical surface component index (for grouping interacting surfaces, see AVL manual) + "yduplicate": np.float64(0.0), # surface is duplicated over the ysymm plane + # "wake": np.int32( + # 1 + # ), # specifies that this surface is to NOT shed a wake, so that its strips will not have their Kutta conditions imposed + # "albe": np.int32( + # 1 + # ), # specifies that this surface is unaffected by freestream direction changes specified by the alpha,beta angles and p,q,r rotation rates + # "load": np.int32( + # 1 + # ), # specifies that the force and moment on this surface is to NOT be included in the overall forces and moments of the configuration + # "clcdsec": np.array( + # [[0.0, 0.0, 0.0, 0.0, 0.0, 0.0], [0.0, 0.0, 0.0, 0.0, 0.0, 0.0]] + # ), # profile-drag CD(CL) function for each section in this surface + # "cdcl": np.array( + # [0.0, 0.0, 0.0, 0.0, 0.0, 0.0] + # ), # profile-drag CD(CL) function for all sections in this surface, overrides Tahnks. + "claf": np.array([1.0, 1.0]), # CL alpha (dCL/da) scaling factor per section + + # Geometry + "scale": np.array( + [1.0, 1.0, 1.0], dtype=np.float64 + ), # scaling factors applied to all x,y,z coordinates (chords arealso scaled by Xscale) + "translate": np.array( + [0.0, 0.0, 0.0], dtype=np.float64 + ), # offset added on to all X,Y,Z values in this surface + # "angle": np.float64(0.0), # offset added on to the Ainc values for all the defining sections in this surface + "xles": np.array([0.0, 0.0]), # leading edge cordinate vector(x component) + "yles": np.array([-5.0, 0.0]), # leading edge cordinate vector(y component) + "zles": np.array([0.0, 0.0]), # leading edge cordinate vector(z component) + "chords": np.array([1.0, 1.0]), # chord length vector + "aincs": np.ones(2),#np.array([0.0, 0.0]), # incidence angle vector + + # Geometry: Cross Sections + # "xfminmax": np.array([[0.0, 1.0], [0.0, 1.0]]), # airfoil x/c limits + # NACA + # 'naca' : np.array(['2412','2412']), # 4-digit NACA airfoil + # Coordinates + # 'xasec': np.array([[0., 1.], [0., 1.]]), # the x coordinate aifoil section + # 'casec': np.array([[0., 0.], [0., 0.]]), # camber line at xasec + # 'tasec': np.array([[0., 0.], [0., 0.]]), # thickness at xasec + # 'xuasec': np.array([[0., 0.], [0., 0.]]), # airfoil upper surface x-coords (alternative to specifying camber line) + # 'xlasec': np.array([[0., 0.], [0., 0.]]), # airfoil lower surface x-coords (alternative to specifying camber line) + # 'zuasec': np.array([[0., 0.], [0., 0.]]), # airfoil upper surface z-coords (alternative to specifying camber line) + # 'zlasec': np.array([[0., 0.], [0., 0.]]), # airfoil lower surface z-coords (alternative to specifying camber line) + # Airfoil Files + 'afiles': np.array(['airfoils/ag40d.dat','airfoils/ag40d.dat']), # airfoil file names + + # Paneling + "nchordwise": np.int32(10), # number of chordwise horseshoe vortice s placed on the surface + "cspace": np.float64(0.0), # chordwise vortex spacing parameter + "nspan": np.int32(6), # number of spanwise horseshoe vortices placed on the entire surface + "sspace": np.float64(0.0), # spanwise vortex spacing parameter for entire surface + # "nspans": np.array([5, 5], dtype=np.int32), # number of spanwise elements vector + # "sspaces": np.array([3.0, 3.0], dtype=np.float64), # spanwise spacing vector (for each section) + "use surface spacing": np.int32( + 1 + ), # surface spacing set under the surface heeading (known as LSURFSPACING in AVL) + + # Control Surfaces + "control_assignments": { + "flap" : {"assignment":np.array([0, 1],dtype=np.int32), + "xhinged": 0.8, # x/c location of hinge + "vhinged": np.zeros(3), # vector giving hinge axis about which surface rotates + "gaind": 1.0, # control surface gain + "refld": 1.0 # control surface reflection, sign of deflection for duplicated surface + } + }, + + # Design Variables (AVL) + "design_var_assignments": { + "des" : {"assignment":np.array([0, 1],dtype=np.int32), + "gaing":1.0} + }, + + } +} + + +geom_mesh = { + "title": "Aircraft", + "mach": np.float64(0.0), + "iysym": np.int32(0), + "izsym": np.int32(0), + "zsym": np.float64(0.0), + "Sref": np.float64(10.0), + "Cref": np.float64(1.0), + "Bref": np.float64(10.0), + "XYZref": np.array([0.25, 0, 0],dtype=np.float64), + "CDp": np.float64(0.0), + "surfaces": surf, + # Global Control and DV info + "dname": ["flap"], # Name of control input for each corresonding index + "gname": ["des"], # Name of design var for each corresonding index +} + +geom_avl = { + "title": "Aircraft", + "mach": np.float64(0.0), + "iysym": np.int32(0), + "izsym": np.int32(0), + "zsym": np.float64(0.0), + "Sref": np.float64(10.0), + "Cref": np.float64(1.0), + "Bref": np.float64(10.0), + "XYZref": np.array([0.25, 0, 0],dtype=np.float64), + "CDp": np.float64(0.0), + "surfaces": surf_avl, + # Global Control and DV info + "dname": ["flap"], # Name of control input for each corresonding index + "gname": ["des"], # Name of design var for each corresonding index +} + +keys_forces = ["CL", "CD"] + +class TestMesh(unittest.TestCase): + def setUp(self): + self.ovl_mesh = OVLSolver(input_dict=geom_mesh) + self.ovl_avl = OVLSolver(input_dict=geom_avl) + + def test_forces(self): + self.ovl_mesh.set_variable("alpha", 2.0) + self.ovl_avl.set_variable("alpha", 2.0) + + self.ovl_mesh.execute_run() + self.ovl_avl.execute_run() + + forces_mesh = self.ovl_mesh.get_total_forces() + forces_avl = self.ovl_avl.get_total_forces() + + for key in keys_forces: + np.testing.assert_allclose( + forces_mesh[key], + forces_avl[key], + rtol=1e-8, + ) + + def test_control_surfaces(self): + + self.ovl_mesh.set_variable("alpha", 0.0) + self.ovl_avl.set_variable("alpha", 0.0) + + self.ovl_mesh.set_control_deflection("flap", 2.0) + self.ovl_avl.set_control_deflection("flap", 2.0) + + self.ovl_mesh.execute_run() + self.ovl_avl.execute_run() + + forces_mesh = self.ovl_mesh.get_total_forces() + forces_avl = self.ovl_avl.get_total_forces() + + for key in keys_forces: + np.testing.assert_allclose( + forces_mesh[key], + forces_avl[key], + rtol=1e-8, + ) + +if __name__ == "__main__": + unittest.main() diff --git a/tests/wing_mesh.npy b/tests/wing_mesh.npy new file mode 100644 index 0000000000000000000000000000000000000000..df1bec448afa04ae02593a8db8e62c2e7f2a0b00 GIT binary patch literal 1976 zcmbW#F-yZh7{>7kPMsY50JlXUOR1oU(9KP8ad47g6CK1#A}->maMF+9H*nImpp%oE zAP9hXJDuq2wD;j7aiXi!cRJD4iLOrH=|orO(_ Date: Mon, 9 Feb 2026 15:39:09 -0500 Subject: [PATCH 38/49] clean up a few things --- tests/test_mesh_input.py | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/test_mesh_input.py b/tests/test_mesh_input.py index 8c62c6d..8dd506b 100644 --- a/tests/test_mesh_input.py +++ b/tests/test_mesh_input.py @@ -3,12 +3,6 @@ # ============================================================================= from optvl import OVLSolver -# ============================================================================= -# Standard Python Modules -# ============================================================================= -import os -from copy import deepcopy - # ============================================================================= # External Python modules # ============================================================================= From e295a2bf753c5c98da1693880f5ba49a5f63a3e9 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 9 Feb 2026 16:12:25 -0500 Subject: [PATCH 39/49] Updated array maximums in python class and added the new NSECMAX param --- optvl/optvl_class.py | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 657774c..b969e4e 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -222,16 +222,17 @@ class OVLSolver(object): ad_suffix = "_DIFF" # Primary array limits: These also need to updated in the Fortran layer if changed - NSMAX = 400 # number of chord strips - NFMAX = 30 # number of surfaces - NLMAX = 500 # number of source/doublet line nodes + NSMAX = 500 # number of chord strips + NSECMAX = 301 # nuber of geometry sections + NFMAX = 100 # number of surfaces + NLMAX = 502 # number of source/doublet line nodes NBMAX = 20 # number of bodies NUMAX = 6 # number of freestream parameters (V,Omega) NDMAX = 30 # number of control deflection parameters - NGMAX = 20 # number of design variables + NGMAX = 21 # number of design variables NRMAX = 25 # number of stored run cases - NTMAX = 5000 # number of stored time levels - IBX = 300 + NTMAX = 503 # number of stored time levels + IBX = 200 ICONX = 20 if platform.system == "Windows": @@ -793,14 +794,14 @@ def check_type(key, avl_vars, given_val, cast_type=True): # This is automatically done by the pre-check routine num_secs = surf_dict["num_sections"] - # Check how many strip/sections we have defined so far and that it doesn't exceed NSMAX + # Check how many strip/sections we have defined so far and that it doesn't exceed NSECMAX cur_secs = np.sum(self.get_avl_fort_arr("SURF_GEOM_I","NSEC")) - if cur_secs + num_secs < self.NSMAX: + if cur_secs + num_secs < self.NSECMAX: # Set total number of sections in one shot self.set_avl_fort_arr("SURF_GEOM_I", "NSEC", num_secs, slicer=idx_surf) else: raise RuntimeError( - f"Number of specified sections/strips exceeds {self.NSMAX}. Raise NSMAX!" + f"Number of specified sections/strips exceeds {self.NSECMAX}. Raise NSECMAX!" ) # Set the number of control and design variables for the surface From f7d02cd526da320dd19276b66f3a3ba63dda8eb2 Mon Sep 17 00:00:00 2001 From: Joshua Anibal Date: Mon, 9 Feb 2026 18:41:43 -0800 Subject: [PATCH 40/49] added unit test for global constants --- optvl/optvl_class.py | 10 ++++------ src/includes/ADIMEN.INC | 6 ------ tests/test_io.py | 34 ++++++++++++++++++++++++++++++---- 3 files changed, 34 insertions(+), 16 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index b969e4e..7cf78a3 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -222,6 +222,7 @@ class OVLSolver(object): ad_suffix = "_DIFF" # Primary array limits: These also need to updated in the Fortran layer if changed + NVMAX = 5000 # number of horseshoe vortices NSMAX = 500 # number of chord strips NSECMAX = 301 # nuber of geometry sections NFMAX = 100 # number of surfaces @@ -232,13 +233,10 @@ class OVLSolver(object): NGMAX = 21 # number of design variables NRMAX = 25 # number of stored run cases NTMAX = 503 # number of stored time levels - IBX = 200 - ICONX = 20 + NOBMAX=1 # max number of off body points + ICONX = 20 # + IBX = 200 # max number of airfoil coordinates - if platform.system == "Windows": - NVMAX = 5000 # number of horseshoe vortices - else: - NVMAX = 6000 # number of horseshoe vortices def __init__( self, diff --git a/src/includes/ADIMEN.INC b/src/includes/ADIMEN.INC index 49daf22..cf2a343 100644 --- a/src/includes/ADIMEN.INC +++ b/src/includes/ADIMEN.INC @@ -57,9 +57,3 @@ PARAMETER (IBX=200) ! max number of airfoil coordinates ! PARAMETER (IBX=300) ! max number of airfoil coordinates - - - - - - diff --git a/tests/test_io.py b/tests/test_io.py index 04ee61b..877de06 100644 --- a/tests/test_io.py +++ b/tests/test_io.py @@ -8,6 +8,7 @@ # ============================================================================= import os import psutil +import re # ============================================================================= # External Python modules @@ -168,11 +169,7 @@ def test_ref_data(self): new_mach, mach0, err_msg=f"Mach does not match set value") - - - - class TestFortranLevelAPI(unittest.TestCase): def setUp(self): self.ovl = OVLSolver(geo_file=geom_file, mass_file=mass_file) @@ -192,6 +189,35 @@ def test_get_array(self): self.assertEqual(chords.shape, (100, 301)) np.testing.assert_array_equal(chords[0, :5], np.array([0.45, 0.45, 0.4, 0.3, 0.2])) +def parse_constants_file(filepath: str) -> dict[str, int]: + constants = {} + with open(filepath, 'r') as f: + for line in f: + line = line.strip() + # Skip comments and blank lines + if not line or line.startswith('!'): + continue + # Skip commented-out PARAMETER lines + if line.startswith('!'): + continue + # Match active PARAMETER lines + match = re.match(r'PARAMETER\s*\(\s*(\w+)\s*=\s*(\d+)\s*\)', line) + if match: + name = match.group(1) + value = int(match.group(2)) + constants[name] = value + return constants + + +class TestConstants(unittest.TestCase): + def setUp(self): + self.ovl = OVLSolver(geo_file=geom_file, mass_file=mass_file) + + def test_constants(self): + # read the constants from src + constants = parse_constants_file(os.path.join(base_dir, "..", "src", "includes", "ADIMEN.INC")) + for var in constants: + assert getattr(self.ovl, var) == constants[var] if __name__ == "__main__": unittest.main() From 889d9e4a5c8f112b243366ab8247fc94a8fe7219 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 10 Feb 2026 17:48:17 -0500 Subject: [PATCH 41/49] Initial AD complete --- src/ad_src/Makefile_tapenade | 4 +- src/ad_src/forward_ad_src/aero_d.f | 149 +- src/ad_src/forward_ad_src/aic_d.f | 45 +- src/ad_src/forward_ad_src/amake_d.f | 1813 ++++++++++++++-- src/ad_src/forward_ad_src/amode_d.f | 4 +- src/ad_src/forward_ad_src/aoper_d.f | 16 +- src/ad_src/forward_ad_src/asetup_d.f | 10 +- src/ad_src/forward_ad_src/atpforc_d.f | 121 +- src/ad_src/forward_ad_src/cdcl_d.f | 2 +- src/ad_src/forward_ad_src/sgutil_d.f | 30 +- src/ad_src/reverse_ad_src/aero_b.f | 359 ++-- src/ad_src/reverse_ad_src/aic_b.f | 152 +- src/ad_src/reverse_ad_src/amake_b.f | 2787 ++++++++++++++++++++++--- src/ad_src/reverse_ad_src/amode_b.f | 4 +- src/ad_src/reverse_ad_src/aoper_b.f | 267 +-- src/ad_src/reverse_ad_src/asetup_b.f | 13 +- src/ad_src/reverse_ad_src/atpforc_b.f | 11 +- src/ad_src/reverse_ad_src/cdcl_b.f | 2 +- src/ad_src/reverse_ad_src/sgutil_b.f | 32 +- src/build/Makefile | 2 +- 20 files changed, 4768 insertions(+), 1055 deletions(-) diff --git a/src/ad_src/Makefile_tapenade b/src/ad_src/Makefile_tapenade index 3d1e36f..f4f386b 100644 --- a/src/ad_src/Makefile_tapenade +++ b/src/ad_src/Makefile_tapenade @@ -26,7 +26,7 @@ PP_FILES = $(addprefix $(PP_DIR)/,$(notdir $(ALL_RES_FILES))) # you also need to add any new files to `src/build/fileList` # ====================== Full List of Routines ================== fullRoutines = "\ - update_surfaces(XYZSCAL,XYZTRAN,ADDINC,XYZLES,CHORDS,AINCS,XASEC,SASEC,TASEC,CLCDSEC,CLAF)>(ENC,ENV, DXV, CHORDV,CHORD, CHORD1, CHORD2, RLE,RLE1,RLE2, WSTRIP, RV1,RV2,RV,RC,RS,RL, ENSY, ENSZ, ESS, XSREF,YSREF,ZSREF, ENC_D)\ + update_surfaces(XYZSCAL,XYZTRAN,ADDINC,XYZLES,CHORDS,MSHBLK,AINCS,XASEC,SASEC,TASEC,CLCDSEC,CLAF)>(ENC,ENV, DXV, CHORDV,CHORD, CHORD1, CHORD2, RLE,RLE1,RLE2, WSTRIP, RV1,RV2,RV,RC,RS,RL, ENSY, ENSZ, ESS, XSREF,YSREF,ZSREF, ENC_D)\ \ get_res(GAM, GAM_D, GAM_U, CONVAL, PARVAL, YSYM, ZSYM, ENC, ENV, DXV, CHORDV, RV1, RV2, RV, RC, RS, RL, ENC_D, XYZREF)>(RES, RES_D, RES_U, GAM, GAM_D, GAM_U, VINF, WROT, VINF_A, VINF_B, ALFA, BETA, DELCON, RV1,RV2, RV, RC,DXV, XYZREF, WV_GAM, CDREF, MACH, SRC, SRC_U)\ \ @@ -103,7 +103,7 @@ ad_forward: preprocess_files clean_fwd python ad_utils/edit_ad_src.py forward --input=forward_tmp --output=forward_ad_src -ad_reverse: preprocess_files +ad_reverse: preprocess_files clean_rev # The following is the single Tapenade command to run: $(TAPENADE_HOME)/bin/tapenade \ diff --git a/src/ad_src/forward_ad_src/aero_d.f b/src/ad_src/forward_ad_src/aero_d.f index 718de70..94e3586 100644 --- a/src/ad_src/forward_ad_src/aero_d.f +++ b/src/ad_src/forward_ad_src/aero_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of aero in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: clff cyff cdff spanef cdtot @@ -85,7 +85,7 @@ SUBROUTINE AERO_D() EXTERNAL GETSA INTEGER is REAL temp - REAL(kind=8) temp0 + REAL(kind=avl_real) temp0 REAL(kind=avl_real) temp1 C cdtot = 0. @@ -321,8 +321,8 @@ SUBROUTINE AERO_D() cmsurfbax(1, is) = dir*cmsurf(1, is) cmsurfbax(2, is) = cmsurf(2, is) cmsurfbax(3, is) = dir*cmsurf(3, is) - ENDDO C compute the stability derivatives every time (it's quite cheap) + ENDDO C C CALL CALC_STAB_DERIVS_D() @@ -488,7 +488,7 @@ SUBROUTINE SFFORC_D() REAL temp INTEGER ii1 REAL temp0 - REAL(kind=8) temp1 + REAL(kind=avl_real) temp1 INTEGER ii2 INTEGER ii3 DATA icrs /2, 3, 1/ @@ -812,6 +812,13 @@ SUBROUTINE SFFORC_D() + ulmag ulift_u(k, n) = temp ENDDO +C write(6,*) 'Strip J ',J +C write(6,*) 'UDRAG ',UDRAG +C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG +C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) +C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) +C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) + ENDDO END IF C @@ -2278,8 +2285,8 @@ SUBROUTINE SFFORC_D() cf_lsrf(l, is) = 0.0 cm_lsrf(l, is) = 0.0 enave(l) = 0.0 - ENDDO C NSTRPS = NJ(IS) + ENDDO C DO jj=1,nj(is) j = jfrst(is) + jj - 1 @@ -2608,12 +2615,6 @@ SUBROUTINE SFFORC_D() C C RETURN -C write(6,*) 'Strip J ',J -C write(6,*) 'UDRAG ',UDRAG -C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG -C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) -C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) -C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) 3 FORMAT(a,6(2x,f8.5)) END @@ -2674,13 +2675,12 @@ SUBROUTINE BDFORC_D() REAL un_u_diff REAL dir EXTERNAL GETSA - REAL(kind=8) arg1 - REAL(kind=8) arg1_diff + REAL(kind=avl_real) arg1 + REAL(kind=avl_real) arg1_diff REAL arg10 REAL arg10_diff REAL(kind=avl_real) temp - REAL(kind=8) temp0 - REAL temp1 + REAL temp0 INTEGER ii1 INTEGER ii2 C @@ -2777,7 +2777,6 @@ SUBROUTINE BDFORC_D() DO ii1=1,3 rrot_diff(ii1) = 0.D0 ENDDO -C compute the forces on the body in the body axis C C C---- add on body force contributions @@ -2816,9 +2815,9 @@ SUBROUTINE BDFORC_D() C l = l1 C - temp0 = (rl(1, l2)-rl(1, l1))/betm - drl_diff(1) = -(temp0*betm_diff/betm) - drl(1) = temp0 + temp = (rl(1, l2)-rl(1, l1))/betm + drl_diff(1) = -(temp*betm_diff/betm) + drl(1) = temp drl_diff(2) = 0.D0 drl(2) = rl(2, l2) - rl(2, l1) drl_diff(3) = 0.D0 @@ -2826,13 +2825,13 @@ SUBROUTINE BDFORC_D() arg10_diff = 2*drl(1)*drl_diff(1) + 2*drl(2)*drl_diff(2) + 2* + drl(3)*drl_diff(3) arg10 = drl(1)**2 + drl(2)**2 + drl(3)**2 - temp1 = SQRT(arg10) + temp0 = SQRT(arg10) IF (arg10 .EQ. 0.D0) THEN drlmag_diff = 0.D0 ELSE - drlmag_diff = arg10_diff/(2.0*temp1) + drlmag_diff = arg10_diff/(2.0*temp0) END IF - drlmag = temp1 + drlmag = temp0 IF (drlmag .EQ. 0.0) THEN drlmi = 0.0 drlmi_diff = 0.D0 @@ -2867,10 +2866,9 @@ SUBROUTINE BDFORC_D() CALL CROSS_D(rrot, rrot_diff, wrot, wrot_diff, vrot, vrot_diff + ) C - temp0 = (vinf(1)+vrot(1))/betm - veff_diff(1) = (vinf_diff(1)+vrot_diff(1)-temp0*betm_diff)/ - + betm - veff(1) = temp0 + temp = (vinf(1)+vrot(1))/betm + veff_diff(1) = (vinf_diff(1)+vrot_diff(1)-temp*betm_diff)/betm + veff(1) = temp veff_diff(2) = vinf_diff(2) + vrot_diff(2) veff(2) = vinf(2) + vrot(2) veff_diff(3) = vinf_diff(3) + vrot_diff(3) @@ -2922,14 +2920,14 @@ SUBROUTINE BDFORC_D() fb(k) = un*src(l) C DO iu=1,6 - temp1 = veff_u(1, iu)*esl(1) + veff_u(2, iu)*esl(2) + + temp0 = veff_u(1, iu)*esl(1) + veff_u(2, iu)*esl(2) + + veff_u(3, iu)*esl(3) un_u_diff = veff_u_diff(k, iu) - esl(k)*(esl(1)* + veff_u_diff(1, iu)+veff_u(1, iu)*esl_diff(1)+esl(2)* + veff_u_diff(2, iu)+veff_u(2, iu)*esl_diff(2)+esl(3)* - + veff_u_diff(3, iu)+veff_u(3, iu)*esl_diff(3)) - temp1* + + veff_u_diff(3, iu)+veff_u(3, iu)*esl_diff(3)) - temp0* + esl_diff(k) - un_u = veff_u(k, iu) - temp1*esl(k) + un_u = veff_u(k, iu) - temp0*esl(k) fb_u_diff(k, iu) = src_u(l, iu)*un_diff + un*src_u_diff(l + , iu) + src(l)*un_u_diff + un_u*src_diff(l) fb_u(k, iu) = un*src_u(l, iu) + un_u*src(l) @@ -2944,74 +2942,74 @@ SUBROUTINE BDFORC_D() + , mb_u(:, iu), mb_u_diff(:, iu)) ENDDO C - temp0 = (fb(1)*cosa+fb(3)*sina)/sref + temp = (fb(1)*cosa+fb(3)*sina)/sref cdbdy_diff(ib) = cdbdy_diff(ib) + 2.0*(cosa*fb_diff(1)+fb(1)* - + cosa_diff+sina*fb_diff(3)+fb(3)*sina_diff-temp0*sref_diff)/ + + cosa_diff+sina*fb_diff(3)+fb(3)*sina_diff-temp*sref_diff)/ + sref - cdbdy(ib) = cdbdy(ib) + 2.0*temp0 - temp0 = fb(2)/sref - cybdy_diff(ib) = cybdy_diff(ib) + 2.0*(fb_diff(2)-temp0* + cdbdy(ib) = cdbdy(ib) + 2.0*temp + temp = fb(2)/sref + cybdy_diff(ib) = cybdy_diff(ib) + 2.0*(fb_diff(2)-temp* + sref_diff)/sref - cybdy(ib) = cybdy(ib) + 2.0*temp0 - temp0 = (fb(3)*cosa-fb(1)*sina)/sref + cybdy(ib) = cybdy(ib) + 2.0*temp + temp = (fb(3)*cosa-fb(1)*sina)/sref clbdy_diff(ib) = clbdy_diff(ib) + 2.0*(cosa*fb_diff(3)+fb(3)* - + cosa_diff-sina*fb_diff(1)-fb(1)*sina_diff-temp0*sref_diff)/ + + cosa_diff-sina*fb_diff(1)-fb(1)*sina_diff-temp*sref_diff)/ + sref - clbdy(ib) = clbdy(ib) + 2.0*temp0 + clbdy(ib) = clbdy(ib) + 2.0*temp DO l=1,3 - temp0 = fb(l)/sref - cfbdy_diff(l, ib) = cfbdy_diff(l, ib) + 2.0*(fb_diff(l)- - + temp0*sref_diff)/sref - cfbdy(l, ib) = cfbdy(l, ib) + 2.0*temp0 + temp = fb(l)/sref + cfbdy_diff(l, ib) = cfbdy_diff(l, ib) + 2.0*(fb_diff(l)-temp + + *sref_diff)/sref + cfbdy(l, ib) = cfbdy(l, ib) + 2.0*temp ENDDO - temp0 = mb(1)/(sref*bref) - cmbdy_diff(1, ib) = cmbdy_diff(1, ib) + 2.0*(mb_diff(1)-temp0* - + (bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy(1, ib) = cmbdy(1, ib) + 2.0*temp0 - temp0 = mb(2)/(sref*cref) - cmbdy_diff(2, ib) = cmbdy_diff(2, ib) + 2.0*(mb_diff(2)-temp0* - + (cref*sref_diff+sref*cref_diff))/(sref*cref) - cmbdy(2, ib) = cmbdy(2, ib) + 2.0*temp0 - temp0 = mb(3)/(sref*bref) - cmbdy_diff(3, ib) = cmbdy_diff(3, ib) + 2.0*(mb_diff(3)-temp0* - + (bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy(3, ib) = cmbdy(3, ib) + 2.0*temp0 + temp = mb(1)/(sref*bref) + cmbdy_diff(1, ib) = cmbdy_diff(1, ib) + 2.0*(mb_diff(1)-temp*( + + bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy(1, ib) = cmbdy(1, ib) + 2.0*temp + temp = mb(2)/(sref*cref) + cmbdy_diff(2, ib) = cmbdy_diff(2, ib) + 2.0*(mb_diff(2)-temp*( + + cref*sref_diff+sref*cref_diff))/(sref*cref) + cmbdy(2, ib) = cmbdy(2, ib) + 2.0*temp + temp = mb(3)/(sref*bref) + cmbdy_diff(3, ib) = cmbdy_diff(3, ib) + 2.0*(mb_diff(3)-temp*( + + bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy(3, ib) = cmbdy(3, ib) + 2.0*temp C DO iu=1,6 - temp0 = (fb_u(1, iu)*cosa+fb_u(3, iu)*sina)/sref + temp = (fb_u(1, iu)*cosa+fb_u(3, iu)*sina)/sref cdbdy_u_diff(iu) = cdbdy_u_diff(iu) + 2.0*(cosa*fb_u_diff(1 + , iu)+fb_u(1, iu)*cosa_diff+sina*fb_u_diff(3, iu)+fb_u(3, - + iu)*sina_diff-temp0*sref_diff)/sref - cdbdy_u(iu) = cdbdy_u(iu) + 2.0*temp0 - temp0 = fb_u(2, iu)/sref + + iu)*sina_diff-temp*sref_diff)/sref + cdbdy_u(iu) = cdbdy_u(iu) + 2.0*temp + temp = fb_u(2, iu)/sref cybdy_u_diff(iu) = cybdy_u_diff(iu) + 2.0*(fb_u_diff(2, iu)- - + temp0*sref_diff)/sref - cybdy_u(iu) = cybdy_u(iu) + 2.0*temp0 - temp0 = (fb_u(3, iu)*cosa-fb_u(1, iu)*sina)/sref + + temp*sref_diff)/sref + cybdy_u(iu) = cybdy_u(iu) + 2.0*temp + temp = (fb_u(3, iu)*cosa-fb_u(1, iu)*sina)/sref clbdy_u_diff(iu) = clbdy_u_diff(iu) + 2.0*(cosa*fb_u_diff(3 + , iu)+fb_u(3, iu)*cosa_diff-sina*fb_u_diff(1, iu)-fb_u(1, - + iu)*sina_diff-temp0*sref_diff)/sref - clbdy_u(iu) = clbdy_u(iu) + 2.0*temp0 + + iu)*sina_diff-temp*sref_diff)/sref + clbdy_u(iu) = clbdy_u(iu) + 2.0*temp C DO l=1,3 - temp0 = fb_u(l, iu)/sref + temp = fb_u(l, iu)/sref cfbdy_u_diff(l, iu) = cfbdy_u_diff(l, iu) + 2.0*(fb_u_diff - + (l, iu)-temp0*sref_diff)/sref - cfbdy_u(l, iu) = cfbdy_u(l, iu) + 2.0*temp0 + + (l, iu)-temp*sref_diff)/sref + cfbdy_u(l, iu) = cfbdy_u(l, iu) + 2.0*temp ENDDO C - temp0 = mb_u(1, iu)/(sref*bref) + temp = mb_u(1, iu)/(sref*bref) cmbdy_u_diff(1, iu) = cmbdy_u_diff(1, iu) + 2.0*(mb_u_diff(1 - + , iu)-temp0*(bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy_u(1, iu) = cmbdy_u(1, iu) + 2.0*temp0 - temp0 = mb_u(2, iu)/(sref*cref) + + , iu)-temp*(bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy_u(1, iu) = cmbdy_u(1, iu) + 2.0*temp + temp = mb_u(2, iu)/(sref*cref) cmbdy_u_diff(2, iu) = cmbdy_u_diff(2, iu) + 2.0*(mb_u_diff(2 - + , iu)-temp0*(cref*sref_diff+sref*cref_diff))/(sref*cref) - cmbdy_u(2, iu) = cmbdy_u(2, iu) + 2.0*temp0 - temp0 = mb_u(3, iu)/(sref*bref) + + , iu)-temp*(cref*sref_diff+sref*cref_diff))/(sref*cref) + cmbdy_u(2, iu) = cmbdy_u(2, iu) + 2.0*temp + temp = mb_u(3, iu)/(sref*bref) cmbdy_u_diff(3, iu) = cmbdy_u_diff(3, iu) + 2.0*(mb_u_diff(3 - + , iu)-temp0*(bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy_u(3, iu) = cmbdy_u(3, iu) + 2.0*temp0 + + , iu)-temp*(bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy_u(3, iu) = cmbdy_u(3, iu) + 2.0*temp ENDDO ENDDO C @@ -3048,6 +3046,7 @@ SUBROUTINE BDFORC_D() ENDDO ENDDO ENDDO +C compute the forces on the body in the body axis C CALL GETSA(lnasa_sa, satype, dir) C diff --git a/src/ad_src/forward_ad_src/aic_d.f b/src/ad_src/forward_ad_src/aic_d.f index 4e78314..330ee5a 100644 --- a/src/ad_src/forward_ad_src/aic_d.f +++ b/src/ad_src/forward_ad_src/aic_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of vvor in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: wc_gam @@ -96,6 +96,7 @@ SUBROUTINE VVOR_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL(kind=avl_real) arg1 REAL(kind=avl_real) arg1_diff REAL(kind=avl_real) temp + REAL(kind=avl_real) temp0 INTEGER ii3 INTEGER ii2 INTEGER ii1 @@ -139,17 +140,18 @@ SUBROUTINE VVOR_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, C DO j=1,nv C--------- set vortex core - arg1_diff = 2*(rv2(2, j)-rv1(2, j))*(rv2_diff(2, j)-rv1_diff(2 - + , j)) + 2*(rv2(3, j)-rv1(3, j))*(rv2_diff(3, j)-rv1_diff(3, - + j)) - arg1 = (rv2(2, j)-rv1(2, j))**2 + (rv2(3, j)-rv1(3, j))**2 - temp = SQRT(arg1) + temp = rv2(2, j) - rv1(2, j) + temp0 = rv2(3, j) - rv1(3, j) + arg1_diff = 2*temp*(rv2_diff(2, j)-rv1_diff(2, j)) + 2*temp0*( + + rv2_diff(3, j)-rv1_diff(3, j)) + arg1 = temp*temp + temp0*temp0 + temp0 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN dsyz_diff = 0.D0 ELSE - dsyz_diff = arg1_diff/(2.0*temp) + dsyz_diff = arg1_diff/(2.0*temp0) END IF - dsyz = temp + dsyz = temp0 C---- default (non-zero) core size based on spanwise lattice spacing rcore_diff = 0.0001*dsyz_diff rcore = 0.0001*dsyz @@ -378,6 +380,8 @@ SUBROUTINE VSRD_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL arg1 REAL arg1_diff REAL temp + REAL temp0 + REAL temp1 INTEGER ii1 INTEGER ii2 INTEGER ii3 @@ -437,19 +441,20 @@ SUBROUTINE VSRD_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, C arg1 = 0.5*(radl(l2)**2+radl(l1)**2) ravg = SQRT(arg1) - arg1_diff = 2*(rl(1, l2)-rl(1, l1))*(rl_diff(1, l2)-rl_diff(1 - + , l1)) + 2*(rl(2, l2)-rl(2, l1))*(rl_diff(2, l2)-rl_diff(2, - + l1)) + 2*(rl(3, l2)-rl(3, l1))*(rl_diff(3, l2)-rl_diff(3, l1 - + )) - arg1 = (rl(1, l2)-rl(1, l1))**2 + (rl(2, l2)-rl(2, l1))**2 + ( - + rl(3, l2)-rl(3, l1))**2 - temp = SQRT(arg1) + temp = rl(1, l2) - rl(1, l1) + temp0 = rl(2, l2) - rl(2, l1) + temp1 = rl(3, l2) - rl(3, l1) + arg1_diff = 2*temp*(rl_diff(1, l2)-rl_diff(1, l1)) + 2*temp0*( + + rl_diff(2, l2)-rl_diff(2, l1)) + 2*temp1*(rl_diff(3, l2)- + + rl_diff(3, l1)) + arg1 = temp*temp + temp0*temp0 + temp1*temp1 + temp1 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN rlavg_diff = 0.D0 ELSE - rlavg_diff = arg1_diff/(2.0*temp) + rlavg_diff = arg1_diff/(2.0*temp1) END IF - rlavg = temp + rlavg = temp1 Ccc print *,'L RAVG, RLAVG ',L,RAVG, RLAVG IF (srcore .GT. 0) THEN rcore = srcore*ravg @@ -565,11 +570,12 @@ SUBROUTINE VSRD_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, ENDDO END IF END IF +C + ENDDO ENDDO ENDDO C -C C RETURN END @@ -841,11 +847,10 @@ SUBROUTINE CROSS_D(u, u_diff, v, v_diff, w, w_diff) C with respect to varying inputs: u v C C - FUNCTION DOT_D(u, u_diff, v, v_diff, dot) + REAL FUNCTION DOT_D(u, u_diff, v, v_diff, dot) REAL u(3), v(3) REAL u_diff(3), v_diff(3) REAL dot - REAL dot_d dot_d = v(1)*u_diff(1) + u(1)*v_diff(1) + v(2)*u_diff(2) + u(2)* + v_diff(2) + v(3)*u_diff(3) + u(3)*v_diff(3) dot = u(1)*v(1) + u(2)*v(2) + u(3)*v(3) diff --git a/src/ad_src/forward_ad_src/amake_d.f b/src/ad_src/forward_ad_src/amake_d.f index 47eb1a6..9ec13ae 100644 --- a/src/ad_src/forward_ad_src/amake_d.f +++ b/src/ad_src/forward_ad_src/amake_d.f @@ -1,20 +1,19 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of update_surfaces in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: rle chord rle1 chord1 rle2 C chord2 wstrip ess ensy ensz xsref ysref zsref C rv1 rv2 rv rc rs dxv chordv enc env enc_d C with respect to varying inputs: xyzscal xyztran addinc xyzles -C chords aincs xasec sasec claf +C chords aincs xasec sasec claf mshblk C RW status of diff variables: xyzscal:in xyztran:in addinc:in C xyzles:in chords:in aincs:in xasec:in sasec:in -C claf:in rle:out chord:out rle1:out chord1:out +C claf:in mshblk:in rle:out chord:out rle1:out chord1:out C rle2:out chord2:out wstrip:out ess:out ensy:out C ensz:out xsref:out ysref:out zsref:out rv1:out C rv2:out rv:out rc:out rs:out dxv:out chordv:out C enc:out env:out enc_d:out -C MAKESURF SUBROUTINE UPDATE_SURFACES_D() use avl_heap_inc use avl_heap_diff_inc @@ -32,6 +31,30 @@ SUBROUTINE UPDATE_SURFACES_D() nstrip = 0 nvor = 0 isurf = 1 + nsurfdupl = 0 + DO ii=1,nsurf + IF (ldupl(ii)) nsurfdupl = nsurfdupl + 1 + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rv1msh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rv2msh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rvmsh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rcmsh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO DO ii1=1,NSTRIP DO ii2=1,3 rle_diff(ii2, ii1) = 0.D0 @@ -120,7 +143,11 @@ SUBROUTINE UPDATE_SURFACES_D() C up the size information as we make each surface DO ii=1,nsurf-nsurfdupl IF (lverbose) WRITE(*, *) 'Updating surface ', isurf - CALL MAKESURF_D(isurf) + IF (lsurfmsh(isurf)) THEN + CALL MAKESURF_MESH_D(isurf) + ELSE + CALL MAKESURF_D(isurf) + END IF IF (ldupl(isurf)) THEN IF (lverbose) WRITE(*, *) ' reduplicating ', isurf CALL SDUPL_D(isurf, ydupl(isurf), 'ydup') @@ -403,9 +430,9 @@ SUBROUTINE MAKESURF_D(isurf) result1 = temp yzlen_diff(isec) = yzlen_diff(isec-1) + result1_diff yzlen(isec) = yzlen(isec-1) + result1 - ENDDO C we can not rely on the original condition becuase NVS(ISURF) is filled C and we may want to rebuild the surface later + ENDDO C IF (nvs(isurf) .EQ. 0 .OR. (lsurfspacing(isurf) .EQV. .false.)) + THEN @@ -523,6 +550,8 @@ SUBROUTINE MAKESURF_D(isurf) iptloc(nsec(isurf)) = npt C C----- fudge spacing array to make nodes match up exactly with interior sections +C Throws an error in the case where the same node is the closest node +C to two consecutive sections DO isec=2,nsec(isurf)-1 ipt1 = iptloc(isec-1) ipt2 = iptloc(isec) @@ -1036,8 +1065,9 @@ SUBROUTINE MAKESURF_D(isurf) phinge(3, idx_strip, n) = rle(3, idx_strip) END IF END IF - ENDDO C + + ENDDO C C--- Interpolate CD-CL polar defining data from input sections to strips DO l=1,6 @@ -1299,13 +1329,1296 @@ SUBROUTINE MAKESURF_D(isurf) + ) END +C Differentiation of makesurf_mesh in forward (tangent) mode (with options i4 dr8 r8): +C variations of useful results: rv1msh rv2msh rvmsh rcmsh rle +C chord rle1 chord1 rle2 chord2 wstrip ainc ainc_g +C rv1 rv2 rv rc rs dxv chordv slopev slopec dcontrol +C vhinge +C with respect to varying inputs: xyzscal xyztran addinc aincs +C xasec sasec claf mshblk rv1msh rv2msh rvmsh rcmsh +C rle chord rle1 chord1 rle2 chord2 wstrip ainc +C ainc_g rv1 rv2 rv rc rs dxv chordv slopev slopec +C dcontrol vhinge +C + SUBROUTINE MAKESURF_MESH_D(isurf) + INCLUDE 'AVL.INC' + INCLUDE 'AVL_ad_seeds.inc' +C working variables (AVL original) + INTEGER isurf + INTEGER kcmax + INTEGER ksmax + PARAMETER (kcmax=50, ksmax=500) + REAL chsin, chcos, chsinl, chsinr, chcosl, chcosr, aincl, aincr, + + chordl, chordr, clafl, clafr, slopel, sloper, dxdx, zu_l, + + zl_l, zu_r, zl_r, zl, zr, sum, wtot, astrp + REAL chsin_diff, chcos_diff, chsinl_diff, chsinr_diff, chcosl_diff + + , chcosr_diff, aincl_diff, aincr_diff, chordl_diff, + + chordr_diff, clafl_diff, clafr_diff, slopel_diff, sloper_diff + REAL chsinl_g(ngmax), chcosl_g(ngmax), chsinr_g(ngmax), chcosr_g( + + ngmax), xled(ndmax), xted(ndmax), gainda(ndmax) + REAL chsinl_g_diff(ngmax), chcosl_g_diff(ngmax), chsinr_g_diff( + + ngmax), chcosr_g_diff(ngmax), xled_diff(ndmax), xted_diff( + + ndmax) +C working variables (OptVL additions) + INTEGER isconl(ndmax), isconr(ndmax) + REAL m1, m2, m3, f1, f2, fc, dc1, dc2, dc, a1, a2, a3, xptxind1, + + xptxind2 + REAL m2_diff, m3_diff, dc1_diff, dc2_diff, a1_diff, a2_diff, + + a3_diff + REAL mesh_surf(3, (nvc(isurf)+1)*(nvs(isurf)+1)) + REAL mesh_surf_diff(3, (nvc(isurf)+1)*(nvs(isurf)+1)) +C functions + INTEGER idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, + + idx_node, idx_nodel, idx_noder, idx_node_yp1, idx_node_nx + + , idx_node_nx_yp1, idx_y, nx, ny +C +C Get data from common block + INTEGER FLATIDX + INTEGER isec + INTEGER ii + INTEGER ispan + INTEGER iptl + INTEGER iptr + INTRINSIC SQRT + INTRINSIC SIN + INTRINSIC COS + INTEGER n + INTEGER iscon + INTEGER isdes + INTRINSIC ATAN2 + REAL chsin_g + REAL chsin_g_diff + REAL chcos_g + REAL chcos_g_diff + INTEGER icl + INTEGER icr + REAL xhd + REAL xhd_diff + REAL vhx + REAL vhx_diff + REAL vhy + REAL vhy_diff + REAL vhz + REAL vhz_diff + REAL vsq + REAL vsq_diff + INTRINSIC ABS + REAL vmod + REAL vmod_diff + INTEGER nsl + INTEGER nsr + REAL clafc + REAL clafc_diff + REAL dx1 + REAL dx1_diff + REAL dx2 + REAL dx2_diff + REAL dx3 + REAL dx3_diff + REAL dsdx + REAL xpt + REAL xpt_diff + REAL fracle + REAL fracle_diff + REAL fracte + REAL fracte_diff + INTRINSIC MAX + INTRINSIC MIN + REAL zu + INTEGER jj + INTEGER j + REAL y1 + REAL y1_diff + REAL y2 + REAL y2_diff + REAL(kind=avl_real) abs0 + REAL(kind=avl_real) abs0_diff + REAL(kind=avl_real) abs1 + REAL(kind=avl_real) abs1_diff + REAL arg1 + REAL arg1_diff + REAL arg2 + REAL arg2_diff + REAL(kind=avl_real) arg10 + REAL(kind=avl_real) arg10_diff + REAL temp + REAL temp0 + REAL(kind=avl_real) temp1 + REAL(kind=avl_real) temp2 +C + nx = nvc(isurf) + 1 +C Check MFRST + ny = nvs(isurf) + 1 +C Get the mesh for this surface from the the common block +C + IF (mfrst(isurf) .EQ. 0) PRINT*, + + '* Provide the index where the mesh begins for surface' + + , isurf +C +C Perform input checks from makesurf (section check removed) + mesh_surf_diff = mshblk_diff(:, mfrst(isurf):mfrst(isurf)+nx*ny-1) + mesh_surf = mshblk(:, mfrst(isurf):mfrst(isurf)+nx*ny-1) +C +C + IF (nvc(isurf) .GT. kcmax) THEN + WRITE(*, *) + + '* makesurf_mesh: Array overflow. Increase KCMAX to', nvc + + (isurf) + nvc(isurf) = kcmax + END IF +C Image flag set to indicate section definition direction +C IMAGS= 1 defines edge 1 located at surface root edge +C IMAGS=-1 defines edge 2 located at surface root edge (reflected surfaces) +C + IF (nvs(isurf) .GT. ksmax) THEN + WRITE(*, *) + + '* makesurf_mesh: Array overflow. Increase KSMAX to', nvs + + (isurf) + nvs(isurf) = ksmax + END IF +C +C Start accumulating the element and strip index references +C Accumulate the first element in surface + imags(isurf) = 1 +C Accumulate the first strip in surface + IF (isurf .EQ. 1) THEN + ifrst(isurf) = 1 + ELSE + ifrst(isurf) = ifrst(isurf-1) + nk(isurf-1)*nj(isurf-1) + END IF +C Set NK from input data (python layer will ensure this is consistent) +C + IF (isurf .EQ. 1) THEN + jfrst(isurf) = 1 + ELSE + jfrst(isurf) = jfrst(isurf-1) + nj(isurf-1) + END IF +C We need to start counting strips now since it is a global count + nk(isurf) = nvc(isurf) +C +C Bypass the entire spanwise node generation routine and go straight to store counters +C skips MAKESURF 94-234 +C Index of first strip in surface +C This is normally used to store the index of each section in AVL +C but since we use strips now each is effectively just a section +C We assign this variable accordingly so as not to break anything else + idx_strip = jfrst(isurf) +C Number of strips/sections in surface +C + IF (isurf .EQ. 1) THEN + icntfrst(isurf) = 1 + ELSE + icntfrst(isurf) = icntfrst(isurf-1) + ncntsec(isurf-1) + END IF +C Store the spanwise index of each strip in each surface + ncntsec(isurf) = nsec(isurf) + DO isec=1,nsec(isurf) + ii = icntfrst(isurf) + (isec-1) + icntsec(ii) = idx_strip +C Apply the scaling and translations to the mesh as a whole + ENDDO +C +C + DO idx_y=1,ny + DO idx_x=1,nx + DO idx_dim=1,3 + idx_node = FLATIDX(idx_x, idx_y, isurf) + mesh_surf_diff(idx_dim, idx_node) = mesh_surf(idx_dim, + + idx_node)*xyzscal_diff(idx_dim, isurf) + xyzscal(idx_dim, + + isurf)*mesh_surf_diff(idx_dim, idx_node) + xyztran_diff( + + idx_dim, isurf) + mesh_surf(idx_dim, idx_node) = xyzscal(idx_dim, isurf)* + + mesh_surf(idx_dim, idx_node) + xyztran(idx_dim, isurf) + ENDDO + ENDDO +C Setup the strips +C Set spanwise elements to 0 + + ENDDO +C +C +C +C Check control and design vars + nj(isurf) = 0 +C + IF (ncontrol .GT. ndmax) THEN + WRITE(*, *) '*** Too many control variables. Increase NDMAX to' + + , ncontrol + STOP + ELSE IF (ndesign .GT. ngmax) THEN +C Instead of looping over sections just loop over all strips in the surface +C + WRITE(*, *) '*** Too many design variables. Increase NGMAX to' + + , ndesign + STOP + ELSE + chcosl_g_diff = 0.D0 + chsinr_g_diff = 0.D0 + xted_diff = 0.D0 + xled_diff = 0.D0 + chsinl_g_diff = 0.D0 + chcosr_g_diff = 0.D0 +C +Cispan loop +C Set reference information for the strip +C This code was used in the original to loop over strips in a section. +C We will just reuse the variables here + DO ispan=1,ny-1 +C +C + idx_y = idx_strip - jfrst(isurf) + 1 + iptl = idx_y + iptr = idx_y + 1 +C We need to compute the chord and claf values at the left and right edge of the strip +C This code was used in the original to interpolate over sections. +C We will just reuse here to interpolate over a strip which is trivial but avoids pointless code rewrites. + nj(isurf) = nj(isurf) + 1 +C +C + idx_node = FLATIDX(1, iptl, isurf) + idx_node_nx = FLATIDX(nx, iptl, isurf) + temp = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) + temp0 = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) + arg1_diff = 2*temp*(mesh_surf_diff(1, idx_node_nx)- + + mesh_surf_diff(1, idx_node)) + 2*temp0*(mesh_surf_diff(3, + + idx_node_nx)-mesh_surf_diff(3, idx_node)) + arg1 = temp*temp + temp0*temp0 + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + chordl_diff = 0.D0 + ELSE + chordl_diff = arg1_diff/(2.0*temp0) + END IF + chordl = temp0 + idx_node = FLATIDX(1, iptr, isurf) + idx_node_nx = FLATIDX(nx, iptr, isurf) + temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) + temp = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) + arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_nx)- + + mesh_surf_diff(1, idx_node)) + 2*temp*(mesh_surf_diff(3, + + idx_node_nx)-mesh_surf_diff(3, idx_node)) + arg1 = temp0*temp0 + temp*temp + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + chordr_diff = 0.D0 + ELSE + chordr_diff = arg1_diff/(2.0*temp0) + END IF + chordr = temp0 + clafl_diff = claf_diff(iptl, isurf) + clafl = claf(iptl, isurf) +C Linearly interpolate the incidence projections over the STRIP + clafr_diff = claf_diff(iptr, isurf) + clafr = claf(iptr, isurf) +C + aincl_diff = dtr*aincs_diff(iptl, isurf) + dtr*addinc_diff( + + isurf) + aincl = aincs(iptl, isurf)*dtr + addinc(isurf)*dtr + aincr_diff = dtr*aincs_diff(iptr, isurf) + dtr*addinc_diff( + + isurf) + aincr = aincs(iptr, isurf)*dtr + addinc(isurf)*dtr + temp0 = SIN(aincl) + chsinl_diff = temp0*chordl_diff + chordl*COS(aincl)*aincl_diff + chsinl = chordl*temp0 + temp0 = SIN(aincr) + chsinr_diff = temp0*chordr_diff + chordr*COS(aincr)*aincr_diff + chsinr = chordr*temp0 + temp0 = COS(aincl) + chcosl_diff = temp0*chordl_diff - chordl*SIN(aincl)*aincl_diff + chcosl = chordl*temp0 +C We need to determine which controls belong to this section +C Bring over the routine for this from makesurf but do it for each strip now + temp0 = COS(aincr) + chcosr_diff = temp0*chordr_diff - chordr*SIN(aincr)*aincr_diff + chcosr = chordr*temp0 +C + DO n=1,ncontrol + isconl(n) = 0 + isconr(n) = 0 + DO iscon=1,nscon(iptl, isurf) + IF (icontd(iscon, iptl, isurf) .EQ. n) isconl(n) = iscon + ENDDO + DO iscon=1,nscon(iptr, isurf) + IF (icontd(iscon, iptr, isurf) .EQ. n) isconr(n) = iscon + ENDDO +C We need to determine which dvs belong to this strip +C and setup the chord projection gains +C Bring over the routine for this from makesurf but setup for strips + + ENDDO +C + DO n=1,ndesign + chsinl_g_diff(n) = 0.D0 + chsinl_g(n) = 0. + chsinr_g_diff(n) = 0.D0 + chsinr_g(n) = 0. + chcosl_g_diff(n) = 0.D0 + chcosl_g(n) = 0. + chcosr_g_diff(n) = 0.D0 + chcosr_g(n) = 0. +C + DO isdes=1,nsdes(iptl, isurf) + IF (idestd(isdes, iptl, isurf) .EQ. n) THEN + chsinl_g_diff(n) = gaing(isdes, iptl, isurf)*dtr* + + chcosl_diff + chsinl_g(n) = chcosl*gaing(isdes, iptl, isurf)*dtr + chcosl_g_diff(n) = -(gaing(isdes, iptl, isurf)*dtr* + + chsinl_diff) + chcosl_g(n) = -(chsinl*gaing(isdes, iptl, isurf)*dtr) + END IF + ENDDO +C + DO isdes=1,nsdes(iptr, isurf) + IF (idestd(isdes, iptr, isurf) .EQ. n) THEN + chsinr_g_diff(n) = gaing(isdes, iptr, isurf)*dtr* + + chcosr_diff + chsinr_g(n) = chcosr*gaing(isdes, iptr, isurf)*dtr + chcosr_g_diff(n) = -(gaing(isdes, iptr, isurf)*dtr* + + chsinr_diff) + chcosr_g(n) = -(chsinr*gaing(isdes, iptr, isurf)*dtr) + END IF + ENDDO +C Set the strip geometry data +C Note these computations assume the mesh is not necessarily planar +C ultimately if/when we flatten the mesh into a planar one we will want +C to use the leading edge positions and chords from the original input mesh +C Strip left side + + ENDDO +C +C +C + idx_node = FLATIDX(1, idx_y, isurf) + idx_node_nx = FLATIDX(nx, idx_y, isurf) + DO idx_dim=1,3 + rle1_diff(idx_dim, idx_strip) = mesh_surf_diff(idx_dim, + + idx_node) + rle1(idx_dim, idx_strip) = mesh_surf(idx_dim, idx_node) + ENDDO +C +C Strip right side + temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) + temp = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) + arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_nx)- + + mesh_surf_diff(1, idx_node)) + 2*temp*(mesh_surf_diff(3, + + idx_node_nx)-mesh_surf_diff(3, idx_node)) + arg1 = temp0*temp0 + temp*temp + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + chord1_diff(idx_strip) = 0.D0 + ELSE + chord1_diff(idx_strip) = arg1_diff/(2.0*temp0) + END IF + chord1(idx_strip) = temp0 +C + idx_node_yp1 = FLATIDX(1, idx_y + 1, isurf) + idx_node_nx_yp1 = FLATIDX(nx, idx_y + 1, isurf) + DO idx_dim=1,3 + rle2_diff(idx_dim, idx_strip) = mesh_surf_diff(idx_dim, + + idx_node_yp1) + rle2(idx_dim, idx_strip) = mesh_surf(idx_dim, idx_node_yp1) + ENDDO +C Strip mid-point + temp0 = mesh_surf(1, idx_node_nx_yp1) - mesh_surf(1, + + idx_node_yp1) + temp = mesh_surf(3, idx_node_nx_yp1) - mesh_surf(3, + + idx_node_yp1) + arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_nx_yp1)- + + mesh_surf_diff(1, idx_node_yp1)) + 2*temp*(mesh_surf_diff(3 + + , idx_node_nx_yp1)-mesh_surf_diff(3, idx_node_yp1)) + arg1 = temp0*temp0 + temp*temp + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + chord2_diff(idx_strip) = 0.D0 + ELSE + chord2_diff(idx_strip) = arg1_diff/(2.0*temp0) + END IF + chord2(idx_strip) = temp0 +C +C Since the strips are linear SPANWISE we can just interpolate + DO idx_dim=1,3 + rle_diff(idx_dim, idx_strip) = (rle1_diff(idx_dim, idx_strip + + )+rle2_diff(idx_dim, idx_strip))/2. + rle(idx_dim, idx_strip) = (rle1(idx_dim, idx_strip)+rle2( + + idx_dim, idx_strip))/2. +C The strips are not necessarily linear chord wise but by definition the chord value is +C so we can interpolate + ENDDO +C Strip geometric incidence angle at the mid-point +C This is strip incidence angle is computed from the LE and TE points +C of the given geometry and is completely independent of AINC +C This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isnt flattened + chord_diff(idx_strip) = (chord1_diff(idx_strip)+chord2_diff( + + idx_strip))/2. + chord(idx_strip) = (chord1(idx_strip)+chord2(idx_strip))/2. +C +C Strip width + arg1 = (mesh_surf(3, idx_node_nx)+mesh_surf(3, idx_node_nx_yp1 + + ))/2. - (mesh_surf(3, idx_node)+mesh_surf(3, idx_node_yp1))/ + + 2. + arg2 = (mesh_surf(1, idx_node_nx)+mesh_surf(1, idx_node_nx_yp1 + + ))/2. - (mesh_surf(1, idx_node)+mesh_surf(1, idx_node_yp1))/ + + 2. + gincstrip(idx_strip) = ATAN2(arg1, arg2) +C + m2_diff = mesh_surf_diff(2, idx_node_yp1) - mesh_surf_diff(2, + + idx_node) + m2 = mesh_surf(2, idx_node_yp1) - mesh_surf(2, idx_node) + m3_diff = mesh_surf_diff(3, idx_node_yp1) - mesh_surf_diff(3, + + idx_node) + m3 = mesh_surf(3, idx_node_yp1) - mesh_surf(3, idx_node) +C Strip LE and TE sweep slopes + arg1_diff = 2*m2*m2_diff + 2*m3*m3_diff + arg1 = m2**2 + m3**2 + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + wstrip_diff(idx_strip) = 0.D0 + ELSE + wstrip_diff(idx_strip) = arg1_diff/(2.0*temp0) + END IF + wstrip(idx_strip) = temp0 +C + tanle(idx_strip) = (mesh_surf(1, idx_node_yp1)-mesh_surf(1, + + idx_node))/wstrip(idx_strip) + idx_node = FLATIDX(nx, idx_y, isurf) + idx_node_yp1 = FLATIDX(nx, idx_y + 1, isurf) +C Compute chord projections and strip twists +C In AVL the AINCS are not interpolated. The chord projections are +C So we have to replicate this effect. +C LINEAR interpolation over the strip: left, right, and midpoint + tante(idx_strip) = (mesh_surf(1, idx_node_yp1)-mesh_surf(1, + + idx_node))/wstrip(idx_strip) +C +C + idx_nodel = FLATIDX(1, iptl, isurf) +C f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ +C & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) +C f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ +C & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) +C fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) +C & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) +C & -mesh_surf(2,idx_nodel)) +C the above expressions will always evaluate to the following for individual strips + idx_noder = FLATIDX(1, iptr, isurf) +C +C + f1 = 0.0 + f2 = 1.0 +C Strip left side incidence +C CHSIN = CHSINL + f1*(CHSINR-CHSINL) +C CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) + fc = 0.5 +C +C Strip right side incidence +C CHSIN = CHSINL + f2*(CHSINR-CHSINL) +C CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) + ainc1(idx_strip) = ATAN2(chsinl, chcosl) +C +C Strip mid-point incidence + ainc2(idx_strip) = ATAN2(chsinr, chcosr) +C + chsin_diff = chsinl_diff + fc*(chsinr_diff-chsinl_diff) + chsin = chsinl + fc*(chsinr-chsinl) + chcos_diff = chcosl_diff + fc*(chcosr_diff-chcosl_diff) + chcos = chcosl + fc*(chcosr-chcosl) +C Set dv gains for incidence angles +C Bring over the routine for this from make surf + ainc_diff(idx_strip) = chcos*chsin_diff/(chsin**2+chcos**2) - + + chsin*chcos_diff/(chsin**2+chcos**2) + ainc(idx_strip) = ATAN2(chsin, chcos) +C + DO n=1,ndesign + chsin_g_diff = (1.0-fc)*chsinl_g_diff(n) + fc*chsinr_g_diff( + + n) + chsin_g = (1.0-fc)*chsinl_g(n) + fc*chsinr_g(n) + chcos_g_diff = (1.0-fc)*chcosl_g_diff(n) + fc*chcosr_g_diff( + + n) + chcos_g = (1.0-fc)*chcosl_g(n) + fc*chcosr_g(n) + temp0 = chsin*chsin + chcos*chcos + temp = (chcos*chsin_g-chsin*chcos_g)/temp0 + ainc_g_diff(idx_strip, n) = (chsin_g*chcos_diff+chcos* + + chsin_g_diff-chcos_g*chsin_diff-chsin*chcos_g_diff-temp*(2 + + *chsin*chsin_diff+2*chcos*chcos_diff))/temp0 + ainc_g(idx_strip, n) = temp +C We have to now setup any control surfaces we defined for this strip +C Bring over the routine for this from makesurf but modified for a strip + ENDDO +C + DO n=1,ncontrol + icl = isconl(n) + icr = isconr(n) +C + IF (icl .EQ. 0 .OR. icr .EQ. 0) THEN +C no control effect here + gainda(n) = 0. + xled_diff(n) = 0.D0 + xled(n) = 0. + xted_diff(n) = 0.D0 + xted(n) = 0. +C + vhinge_diff(1, idx_strip, n) = 0.D0 + vhinge(1, idx_strip, n) = 0. + vhinge_diff(2, idx_strip, n) = 0.D0 + vhinge(2, idx_strip, n) = 0. + vhinge_diff(3, idx_strip, n) = 0.D0 + vhinge(3, idx_strip, n) = 0. +C + vrefl(idx_strip, n) = 0. +C + phinge(1, idx_strip, n) = 0. + phinge(2, idx_strip, n) = 0. + phinge(3, idx_strip, n) = 0. +C + ELSE +C control variable # N is active here +C SAB Note: This interpolation ensures that the hinge line is +C is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware +C A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord + gainda(n) = gaind(icl, iptl, isurf)*(1.0-fc) + gaind(icr, + + iptr, isurf)*fc +C + xhd_diff = xhinged(icl, iptl, isurf)*(1.0-fc)*chordl_diff + + + xhinged(icr, iptr, isurf)*fc*chordr_diff + xhd = chordl*xhinged(icl, iptl, isurf)*(1.0-fc) + chordr* + + xhinged(icr, iptr, isurf)*fc + IF (xhd .GE. 0.0) THEN +C TE control surface, with hinge at XHD + xled_diff(n) = xhd_diff + xled(n) = xhd + xted_diff(n) = chord_diff(idx_strip) + xted(n) = chord(idx_strip) + ELSE +C LE control surface, with hinge at -XHD + xled_diff(n) = 0.D0 + xled(n) = 0.0 + xted_diff(n) = -xhd_diff + xted(n) = -xhd + END IF +C + vhx_diff = vhinged(1, icl, iptl, isurf)*xyzscal_diff(1, + + isurf) + vhx = vhinged(1, icl, iptl, isurf)*xyzscal(1, isurf) + vhy_diff = vhinged(2, icl, iptl, isurf)*xyzscal_diff(2, + + isurf) + vhy = vhinged(2, icl, iptl, isurf)*xyzscal(2, isurf) + vhz_diff = vhinged(3, icl, iptl, isurf)*xyzscal_diff(3, + + isurf) + vhz = vhinged(3, icl, iptl, isurf)*xyzscal(3, isurf) + vsq_diff = 2*vhx*vhx_diff + 2*vhy*vhy_diff + 2*vhz* + + vhz_diff + vsq = vhx**2 + vhy**2 + vhz**2 + IF (vsq .EQ. 0.0) THEN + IF (chordr*xhinged(icr, iptr, isurf) .GE. 0.) THEN + abs0_diff = xhinged(icr, iptr, isurf)*chordr_diff + abs0 = chordr*xhinged(icr, iptr, isurf) + ELSE + abs0_diff = -(xhinged(icr, iptr, isurf)*chordr_diff) + abs0 = -(chordr*xhinged(icr, iptr, isurf)) + END IF + IF (chordl*xhinged(icl, iptl, isurf) .GE. 0.) THEN + abs1_diff = xhinged(icl, iptl, isurf)*chordl_diff + abs1 = chordl*xhinged(icl, iptl, isurf) + ELSE + abs1_diff = -(xhinged(icl, iptl, isurf)*chordl_diff) + abs1 = -(chordl*xhinged(icl, iptl, isurf)) + END IF +C default: set hinge vector along hingeline +C We are just setting the hinge line across the section +C this assumes the hinge is linear even for a nonlinear wing + vhx_diff = mesh_surf_diff(1, idx_noder) + abs0_diff - + + mesh_surf_diff(1, idx_nodel) - abs1_diff + vhx = mesh_surf(1, idx_noder) + abs0 - mesh_surf(1, + + idx_nodel) - abs1 + vhy_diff = mesh_surf_diff(2, idx_noder) - mesh_surf_diff + + (2, idx_nodel) + vhy = mesh_surf(2, idx_noder) - mesh_surf(2, idx_nodel) + vhz_diff = mesh_surf_diff(3, idx_noder) - mesh_surf_diff + + (3, idx_nodel) + vhz = mesh_surf(3, idx_noder) - mesh_surf(3, idx_nodel) + vhx_diff = xyzscal(1, isurf)*vhx_diff + vhx*xyzscal_diff + + (1, isurf) + vhx = vhx*xyzscal(1, isurf) + vhy_diff = xyzscal(2, isurf)*vhy_diff + vhy*xyzscal_diff + + (2, isurf) + vhy = vhy*xyzscal(2, isurf) + vhz_diff = xyzscal(3, isurf)*vhz_diff + vhz*xyzscal_diff + + (3, isurf) + vhz = vhz*xyzscal(3, isurf) + vsq_diff = 2*vhx*vhx_diff + 2*vhy*vhy_diff + 2*vhz* + + vhz_diff + vsq = vhx**2 + vhy**2 + vhz**2 + END IF +C + temp0 = SQRT(vsq) + IF (vsq .EQ. 0.D0) THEN + vmod_diff = 0.D0 + ELSE + vmod_diff = vsq_diff/(2.0*temp0) + END IF + vmod = temp0 + vhinge_diff(1, idx_strip, n) = (vhx_diff-vhx*vmod_diff/ + + vmod)/vmod + vhinge(1, idx_strip, n) = vhx/vmod + vhinge_diff(2, idx_strip, n) = (vhy_diff-vhy*vmod_diff/ + + vmod)/vmod + vhinge(2, idx_strip, n) = vhy/vmod + vhinge_diff(3, idx_strip, n) = (vhz_diff-vhz*vmod_diff/ + + vmod)/vmod + vhinge(3, idx_strip, n) = vhz/vmod +C + vrefl(idx_strip, n) = refld(icl, iptl, isurf) +C + IF (xhd .GE. 0.0) THEN + phinge(1, idx_strip, n) = rle(1, idx_strip) + xhd + phinge(2, idx_strip, n) = rle(2, idx_strip) + phinge(3, idx_strip, n) = rle(3, idx_strip) + ELSE + phinge(1, idx_strip, n) = rle(1, idx_strip) - xhd + phinge(2, idx_strip, n) = rle(2, idx_strip) + phinge(3, idx_strip, n) = rle(3, idx_strip) + END IF + END IF +C Interpolate CD-CL polar defining data from input to strips + + ENDDO +C + DO idx_coef=1,6 + clcd(idx_coef, idx_strip) = (1.0-fc)*clcdsec(idx_coef, iptl + + , isurf) + fc*clcdsec(idx_coef, iptr, isurf) +C If the min drag is zero flag the strip as no-viscous data + ENDDO +C Set the panel (vortex) geometry data +C Accumulate the strip element indicies and start counting vorticies + lviscstrp(idx_strip) = clcd(4, idx_strip) .NE. 0.0 +C + IF (idx_strip .EQ. 1) THEN + ijfrst(idx_strip) = 1 + ELSE + ijfrst(idx_strip) = ijfrst(idx_strip-1) + nvstrp(idx_strip-1 + + ) + END IF + idx_vor = ijfrst(idx_strip) +C Associate the strip with the surface + nvstrp(idx_strip) = nvc(isurf) +C +C Prepare for cross section interpolation + lssurf(idx_strip) = isurf +C + nsl = nasec(iptl, isurf) +C CHORDC = CHORD(idx_strip) +C Funny story. this original line is now valid now that we interpolate over the strip + nsr = nasec(iptr, isurf) +C +C +C +C Suggestion from Hal Yougren for non linear sections: +C clafc = (1.-fc)*clafl + fc*clafr +C loop over vorticies for the strip + temp1 = chordl*clafl/chord(idx_strip) + temp2 = chordr*clafr/chord(idx_strip) + clafc_diff = (1.-fc)*(clafl*chordl_diff+chordl*clafl_diff- + + temp1*chord_diff(idx_strip))/chord(idx_strip) + fc*(clafr* + + chordr_diff+chordr*clafr_diff-temp2*chord_diff(idx_strip))/ + + chord(idx_strip) + clafc = (1.-fc)*temp1 + fc*temp2 +C +C Left bound vortex points + DO idx_x=1,nvc(isurf) +C Compute the panel left side chord + idx_node = FLATIDX(idx_x, idx_y, isurf) + temp0 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) + temp = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) + arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node+1)- + + mesh_surf_diff(1, idx_node)) + 2*temp*(mesh_surf_diff(3, + + idx_node+1)-mesh_surf_diff(3, idx_node)) + arg1 = temp0*temp0 + temp*temp + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + dc1_diff = 0.D0 + ELSE + dc1_diff = arg1_diff/(2.0*temp0) + END IF + dc1 = temp0 +C Right bound vortex points +C + IF (lmeshflat(isurf)) THEN +C Place vortex at panel quarter chord of the flat mesh + temp2 = mesh_surf(1, idx_node) - rle1(1, idx_strip) + temp1 = mesh_surf(3, idx_node) - rle1(3, idx_strip) + arg10_diff = 2*temp2*(mesh_surf_diff(1, idx_node)- + + rle1_diff(1, idx_strip)) + 2*temp1*(mesh_surf_diff(3, + + idx_node)-rle1_diff(3, idx_strip)) + arg10 = temp2*temp2 + temp1*temp1 + temp2 = SQRT(arg10) + IF (arg10 .EQ. 0.D0) THEN + dx1_diff = 0.D0 + ELSE + dx1_diff = arg10_diff/(2.0*temp2) + END IF + dx1 = temp2 + rv1_diff(2, idx_vor) = rle1_diff(2, idx_strip) + rv1(2, idx_vor) = rle1(2, idx_strip) + rv1_diff(3, idx_vor) = rle1_diff(3, idx_strip) + rv1(3, idx_vor) = rle1(3, idx_strip) +C Compute the panel left side angle + rv1_diff(1, idx_vor) = rle1_diff(1, idx_strip) + dx1_diff + + + dc1_diff/4. + rv1(1, idx_vor) = rle1(1, idx_strip) + dx1 + dc1/4. +C Place vortex at panel quarter chord of the true mesh + temp0 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) + temp = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) + a1_diff = temp0*(mesh_surf_diff(3, idx_node+1)- + + mesh_surf_diff(3, idx_node))/(temp**2+temp0**2) - temp*( + + mesh_surf_diff(1, idx_node+1)-mesh_surf_diff(1, idx_node + + ))/(temp**2+temp0**2) + a1 = ATAN2(temp, temp0) + rv1msh_diff(2, idx_vor) = mesh_surf_diff(2, idx_node) + rv1msh(2, idx_vor) = mesh_surf(2, idx_node) + temp0 = COS(a1) + rv1msh_diff(1, idx_vor) = mesh_surf_diff(1, idx_node) + + + temp0*dc1_diff/4. - dc1*SIN(a1)*a1_diff/4. + rv1msh(1, idx_vor) = mesh_surf(1, idx_node) + dc1/4.*temp0 + temp0 = SIN(a1) + rv1msh_diff(3, idx_vor) = mesh_surf_diff(3, idx_node) + + + temp0*dc1_diff/4. + dc1*COS(a1)*a1_diff/4. + rv1msh(3, idx_vor) = mesh_surf(3, idx_node) + dc1/4.*temp0 + ELSE +C Compute the panel left side angle +C Place vortex at panel quarter chord + temp0 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) + temp = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) + a1_diff = temp0*(mesh_surf_diff(3, idx_node+1)- + + mesh_surf_diff(3, idx_node))/(temp**2+temp0**2) - temp*( + + mesh_surf_diff(1, idx_node+1)-mesh_surf_diff(1, idx_node + + ))/(temp**2+temp0**2) + a1 = ATAN2(temp, temp0) + rv1_diff(2, idx_vor) = mesh_surf_diff(2, idx_node) + rv1(2, idx_vor) = mesh_surf(2, idx_node) + temp0 = COS(a1) + rv1_diff(1, idx_vor) = mesh_surf_diff(1, idx_node) + temp0 + + *dc1_diff/4. - dc1*SIN(a1)*a1_diff/4. + rv1(1, idx_vor) = mesh_surf(1, idx_node) + dc1/4.*temp0 +C Make a copy in the true mesh array for post processing + temp0 = SIN(a1) + rv1_diff(3, idx_vor) = mesh_surf_diff(3, idx_node) + temp0 + + *dc1_diff/4. + dc1*COS(a1)*a1_diff/4. + rv1(3, idx_vor) = mesh_surf(3, idx_node) + dc1/4.*temp0 + rv1msh_diff(2, idx_vor) = rv1_diff(2, idx_vor) + rv1msh(2, idx_vor) = rv1(2, idx_vor) + rv1msh_diff(1, idx_vor) = rv1_diff(1, idx_vor) + rv1msh(1, idx_vor) = rv1(1, idx_vor) + rv1msh_diff(3, idx_vor) = rv1_diff(3, idx_vor) + rv1msh(3, idx_vor) = rv1(3, idx_vor) + END IF +C Compute the panel right side chord + idx_node_yp1 = FLATIDX(idx_x, idx_y + 1, isurf) + temp0 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, + + idx_node_yp1) + temp = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1) + arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_yp1+1)- + + mesh_surf_diff(1, idx_node_yp1)) + 2*temp*(mesh_surf_diff( + + 3, idx_node_yp1+1)-mesh_surf_diff(3, idx_node_yp1)) + arg1 = temp0*temp0 + temp*temp + temp0 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + dc2_diff = 0.D0 + ELSE + dc2_diff = arg1_diff/(2.0*temp0) + END IF + dc2 = temp0 +C Mid-point bound vortex points +C Compute the panel mid-point chord +C Panels themselves can never be curved so just interpolate the chord +C store as the panel chord in common block +C + IF (lmeshflat(isurf)) THEN +C Place vortex at panel quarter chord of the flat mesh + temp2 = mesh_surf(1, idx_node_yp1) - rle2(1, idx_strip) + temp1 = mesh_surf(3, idx_node_yp1) - rle2(3, idx_strip) + arg10_diff = 2*temp2*(mesh_surf_diff(1, idx_node_yp1)- + + rle2_diff(1, idx_strip)) + 2*temp1*(mesh_surf_diff(3, + + idx_node_yp1)-rle2_diff(3, idx_strip)) + arg10 = temp2*temp2 + temp1*temp1 + temp2 = SQRT(arg10) + IF (arg10 .EQ. 0.D0) THEN + dx2_diff = 0.D0 + ELSE + dx2_diff = arg10_diff/(2.0*temp2) + END IF + dx2 = temp2 +C + rv2_diff(2, idx_vor) = rle2_diff(2, idx_strip) + rv2(2, idx_vor) = rle2(2, idx_strip) + rv2_diff(3, idx_vor) = rle2_diff(3, idx_strip) + rv2(3, idx_vor) = rle2(3, idx_strip) +C Compute the panel right side angle + rv2_diff(1, idx_vor) = rle2_diff(1, idx_strip) + dx2_diff + + + dc2_diff/4. + rv2(1, idx_vor) = rle2(1, idx_strip) + dx2 + dc2/4. +C +C Place vortex at panel quarter chord of the true mesh + temp0 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, + + idx_node_yp1) + temp = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1) + a2_diff = temp0*(mesh_surf_diff(3, idx_node_yp1+1)- + + mesh_surf_diff(3, idx_node_yp1))/(temp**2+temp0**2) - + + temp*(mesh_surf_diff(1, idx_node_yp1+1)-mesh_surf_diff(1 + + , idx_node_yp1))/(temp**2+temp0**2) + a2 = ATAN2(temp, temp0) + rv2msh_diff(2, idx_vor) = mesh_surf_diff(2, idx_node_yp1) + rv2msh(2, idx_vor) = mesh_surf(2, idx_node_yp1) + temp0 = COS(a2) + rv2msh_diff(1, idx_vor) = mesh_surf_diff(1, idx_node_yp1) + + + temp0*dc2_diff/4. - dc2*SIN(a2)*a2_diff/4. + rv2msh(1, idx_vor) = mesh_surf(1, idx_node_yp1) + dc2/4.* + + temp0 + temp0 = SIN(a2) + rv2msh_diff(3, idx_vor) = mesh_surf_diff(3, idx_node_yp1) + + + temp0*dc2_diff/4. + dc2*COS(a2)*a2_diff/4. + rv2msh(3, idx_vor) = mesh_surf(3, idx_node_yp1) + dc2/4.* + + temp0 + ELSE +C Compute the panel right side angle +C Place vortex at panel quarter chord + temp0 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, + + idx_node_yp1) + temp = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1) + a2_diff = temp0*(mesh_surf_diff(3, idx_node_yp1+1)- + + mesh_surf_diff(3, idx_node_yp1))/(temp**2+temp0**2) - + + temp*(mesh_surf_diff(1, idx_node_yp1+1)-mesh_surf_diff(1 + + , idx_node_yp1))/(temp**2+temp0**2) + a2 = ATAN2(temp, temp0) + rv2_diff(2, idx_vor) = mesh_surf_diff(2, idx_node_yp1) + rv2(2, idx_vor) = mesh_surf(2, idx_node_yp1) + temp0 = COS(a2) + rv2_diff(1, idx_vor) = mesh_surf_diff(1, idx_node_yp1) + + + temp0*dc2_diff/4. - dc2*SIN(a2)*a2_diff/4. + rv2(1, idx_vor) = mesh_surf(1, idx_node_yp1) + dc2/4.* + + temp0 +C Make a copy in the true mesh array for post processing + temp0 = SIN(a2) + rv2_diff(3, idx_vor) = mesh_surf_diff(3, idx_node_yp1) + + + temp0*dc2_diff/4. + dc2*COS(a2)*a2_diff/4. + rv2(3, idx_vor) = mesh_surf(3, idx_node_yp1) + dc2/4.* + + temp0 +C + rv2msh_diff(2, idx_vor) = rv2_diff(2, idx_vor) + rv2msh(2, idx_vor) = rv2(2, idx_vor) + rv2msh_diff(1, idx_vor) = rv2_diff(1, idx_vor) + rv2msh(1, idx_vor) = rv2(1, idx_vor) + rv2msh_diff(3, idx_vor) = rv2_diff(3, idx_vor) + rv2msh(3, idx_vor) = rv2(3, idx_vor) + END IF +C +C We need to compute the midpoint angle and panel strip chord projection +C as we need them to compute normals based on the real mesh + dxv_diff(idx_vor) = (dc1_diff+dc2_diff)/2. + dxv(idx_vor) = (dc1+dc2)/2. +C project the panel chord onto the strip chord + arg1_diff = (mesh_surf_diff(3, idx_node_yp1+1)+ + + mesh_surf_diff(3, idx_node+1))/2. - (mesh_surf_diff(3, + + idx_node_yp1)+mesh_surf_diff(3, idx_node))/2. + arg1 = (mesh_surf(3, idx_node_yp1+1)+mesh_surf(3, idx_node+1 + + ))/2. - (mesh_surf(3, idx_node_yp1)+mesh_surf(3, idx_node) + + )/2. + arg2_diff = (mesh_surf_diff(1, idx_node_yp1+1)+ + + mesh_surf_diff(1, idx_node+1))/2. - (mesh_surf_diff(1, + + idx_node_yp1)+mesh_surf_diff(1, idx_node))/2. + arg2 = (mesh_surf(1, idx_node_yp1+1)+mesh_surf(1, idx_node+1 + + ))/2. - (mesh_surf(1, idx_node_yp1)+mesh_surf(1, idx_node) + + )/2. + a3_diff = arg2*arg1_diff/(arg1**2+arg2**2) - arg1*arg2_diff/ + + (arg1**2+arg2**2) + a3 = ATAN2(arg1, arg2) + dxstrpv(idx_vor) = dxv(idx_vor)*COS(a3-gincstrip(idx_strip)) +C Panel Control points +C Y- point +C is just the panel midpoint +C + IF (lmeshflat(isurf)) THEN +C Place vortex at panel quarter chord of the flat mesh + temp2 = (mesh_surf(1, idx_node_yp1)+mesh_surf(1, idx_node) + + )/2 - rle(1, idx_strip) + temp1 = (mesh_surf(3, idx_node_yp1)+mesh_surf(3, idx_node) + + )/2 - rle(3, idx_strip) + arg10_diff = 2*temp2*((mesh_surf_diff(1, idx_node_yp1)+ + + mesh_surf_diff(1, idx_node))/2-rle_diff(1, idx_strip)) + + + 2*temp1*((mesh_surf_diff(3, idx_node_yp1)+mesh_surf_diff + + (3, idx_node))/2-rle_diff(3, idx_strip)) + arg10 = temp2*temp2 + temp1*temp1 + temp2 = SQRT(arg10) + IF (arg10 .EQ. 0.D0) THEN + dx3_diff = 0.D0 + ELSE + dx3_diff = arg10_diff/(2.0*temp2) + END IF + dx3 = temp2 + rv_diff(2, idx_vor) = rle_diff(2, idx_strip) + rv(2, idx_vor) = rle(2, idx_strip) + rv_diff(3, idx_vor) = rle_diff(3, idx_strip) + rv(3, idx_vor) = rle(3, idx_strip) +C Place vortex at panel quarter chord of the true mesh + rv_diff(1, idx_vor) = rle_diff(1, idx_strip) + dx3_diff + + + dxv_diff(idx_vor)/4. + rv(1, idx_vor) = rle(1, idx_strip) + dx3 + dxv(idx_vor)/4. +C + rvmsh_diff(2, idx_vor) = (mesh_surf_diff(2, idx_node_yp1)+ + + mesh_surf_diff(2, idx_node))/2. + rvmsh(2, idx_vor) = (mesh_surf(2, idx_node_yp1)+mesh_surf( + + 2, idx_node))/2. + temp0 = COS(a3) + temp2 = dxv(idx_vor)/4. + rvmsh_diff(1, idx_vor) = (mesh_surf_diff(1, idx_node_yp1)+ + + mesh_surf_diff(1, idx_node))/2. + temp0*dxv_diff(idx_vor + + )/4. - temp2*SIN(a3)*a3_diff + rvmsh(1, idx_vor) = (mesh_surf(1, idx_node_yp1)+mesh_surf( + + 1, idx_node))/2. + temp2*temp0 + temp0 = SIN(a3) + temp2 = dxv(idx_vor)/4. + rvmsh_diff(3, idx_vor) = (mesh_surf_diff(3, idx_node_yp1)+ + + mesh_surf_diff(3, idx_node))/2. + temp0*dxv_diff(idx_vor + + )/4. + temp2*COS(a3)*a3_diff + rvmsh(3, idx_vor) = (mesh_surf(3, idx_node_yp1)+mesh_surf( + + 3, idx_node))/2. + temp2*temp0 + ELSE +C Place vortex at panel quarter chord + rv_diff(2, idx_vor) = (mesh_surf_diff(2, idx_node_yp1)+ + + mesh_surf_diff(2, idx_node))/2. + rv(2, idx_vor) = (mesh_surf(2, idx_node_yp1)+mesh_surf(2, + + idx_node))/2. + temp0 = COS(a3) + temp2 = dxv(idx_vor)/4. + rv_diff(1, idx_vor) = (mesh_surf_diff(1, idx_node_yp1)+ + + mesh_surf_diff(1, idx_node))/2. + temp0*dxv_diff(idx_vor + + )/4. - temp2*SIN(a3)*a3_diff + rv(1, idx_vor) = (mesh_surf(1, idx_node_yp1)+mesh_surf(1, + + idx_node))/2. + temp2*temp0 +C Make a copy in the true mesh array for post processing + temp0 = SIN(a3) + temp2 = dxv(idx_vor)/4. + rv_diff(3, idx_vor) = (mesh_surf_diff(3, idx_node_yp1)+ + + mesh_surf_diff(3, idx_node))/2. + temp0*dxv_diff(idx_vor + + )/4. + temp2*COS(a3)*a3_diff + rv(3, idx_vor) = (mesh_surf(3, idx_node_yp1)+mesh_surf(3, + + idx_node))/2. + temp2*temp0 +C + rvmsh_diff(2, idx_vor) = rv_diff(2, idx_vor) + rvmsh(2, idx_vor) = rv(2, idx_vor) + rvmsh_diff(1, idx_vor) = rv_diff(1, idx_vor) + rvmsh(1, idx_vor) = rv(1, idx_vor) + rvmsh_diff(3, idx_vor) = rv_diff(3, idx_vor) + rvmsh(3, idx_vor) = rv(3, idx_vor) + END IF +C +C +C Place the control point at the quarter chord + half chord*clafc +C note that clafc is a scaler so is 1. is for 2pi +C use data from vortex mid-point computation + rc_diff(2, idx_vor) = rv_diff(2, idx_vor) + rc(2, idx_vor) = rv(2, idx_vor) +C Source points +C Y- point + IF (lmeshflat(isurf)) THEN + rc_diff(1, idx_vor) = rv_diff(1, idx_vor) + dxv(idx_vor)* + + clafc_diff/2. + clafc*dxv_diff(idx_vor)/2. + rc(1, idx_vor) = rv(1, idx_vor) + clafc*(dxv(idx_vor)/2.) + rc_diff(3, idx_vor) = rv_diff(3, idx_vor) + rc(3, idx_vor) = rv(3, idx_vor) +C + temp0 = COS(a3) + temp2 = clafc*dxv(idx_vor)/2. + rcmsh_diff(1, idx_vor) = rvmsh_diff(1, idx_vor) + temp0*( + + dxv(idx_vor)*clafc_diff/2.+clafc*dxv_diff(idx_vor)/2.) - + + temp2*SIN(a3)*a3_diff + rcmsh(1, idx_vor) = rvmsh(1, idx_vor) + temp2*temp0 + temp0 = SIN(a3) + temp2 = clafc*dxv(idx_vor)/2. + rcmsh_diff(3, idx_vor) = rvmsh_diff(3, idx_vor) + temp0*( + + dxv(idx_vor)*clafc_diff/2.+clafc*dxv_diff(idx_vor)/2.) + + + temp2*COS(a3)*a3_diff + rcmsh(3, idx_vor) = rvmsh(3, idx_vor) + temp2*temp0 + rcmsh_diff(2, idx_vor) = rvmsh_diff(2, idx_vor) + rcmsh(2, idx_vor) = rvmsh(2, idx_vor) + ELSE + temp0 = COS(a3) + temp2 = clafc*dxv(idx_vor)/2. + rc_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp0*(dxv( + + idx_vor)*clafc_diff/2.+clafc*dxv_diff(idx_vor)/2.) - + + temp2*SIN(a3)*a3_diff + rc(1, idx_vor) = rv(1, idx_vor) + temp2*temp0 +C Make a copy in the true mesh array for post processing + temp0 = SIN(a3) + temp2 = clafc*dxv(idx_vor)/2. + rc_diff(3, idx_vor) = rv_diff(3, idx_vor) + temp0*(dxv( + + idx_vor)*clafc_diff/2.+clafc*dxv_diff(idx_vor)/2.) + + + temp2*COS(a3)*a3_diff + rc(3, idx_vor) = rv(3, idx_vor) + temp2*temp0 +C + rcmsh_diff(1, idx_vor) = rc_diff(1, idx_vor) + rcmsh(1, idx_vor) = rc(1, idx_vor) + rcmsh_diff(3, idx_vor) = rc_diff(3, idx_vor) + rcmsh(3, idx_vor) = rc(3, idx_vor) + rcmsh_diff(2, idx_vor) = rc_diff(2, idx_vor) + rcmsh(2, idx_vor) = rc(2, idx_vor) + END IF +C +C Place the source point at the half chord +C use data from vortex mid-point computation +C add another quarter chord to the quarter chord + rs_diff(2, idx_vor) = rv_diff(2, idx_vor) + rs(2, idx_vor) = rv(2, idx_vor) +C Set the camber slopes for the panel +C Camber slope at control point + IF (lmeshflat(isurf)) THEN + rs_diff(1, idx_vor) = rv_diff(1, idx_vor) + dxv_diff( + + idx_vor)/4. + rs(1, idx_vor) = rv(1, idx_vor) + dxv(idx_vor)/4. + rs_diff(3, idx_vor) = rv_diff(3, idx_vor) + dxv_diff( + + idx_vor)/4. + rs(3, idx_vor) = rv(3, idx_vor) + dxv(idx_vor)/4. + ELSE + temp0 = COS(a3) + temp2 = dxv(idx_vor)/4. + rs_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp0*dxv_diff + + (idx_vor)/4. - temp2*SIN(a3)*a3_diff + rs(1, idx_vor) = rv(1, idx_vor) + temp2*temp0 + temp0 = SIN(a3) + temp2 = dxv(idx_vor)/4. + rs_diff(3, idx_vor) = rv_diff(3, idx_vor) + temp0*dxv_diff + + (idx_vor)/4. + temp2*COS(a3)*a3_diff + rs(3, idx_vor) = rv(3, idx_vor) + temp2*temp0 + END IF +C +C + temp2 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL AKIMA_D(xasec(1, iptl, isurf), xasec_diff(1, iptl, + + isurf), sasec(1, iptl, isurf), sasec_diff(1, + + iptl, isurf), nsl, (rc(1, idx_vor)-rle(1, + + idx_strip))/chord(idx_strip), (rc_diff(1, + + idx_vor)-rle_diff(1, idx_strip)-temp2* + + chord_diff(idx_strip))/chord(idx_strip), slopel + + , slopel_diff, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip + temp2 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL AKIMA_D(xasec(1, iptr, isurf), xasec_diff(1, iptr, + + isurf), sasec(1, iptr, isurf), sasec_diff(1, + + iptr, isurf), nsr, (rc(1, idx_vor)-rle(1, + + idx_strip))/chord(idx_strip), (rc_diff(1, + + idx_vor)-rle_diff(1, idx_strip)-temp2* + + chord_diff(idx_strip))/chord(idx_strip), sloper + + , sloper_diff, dsdx) +C +C Camber slope at vortex mid-point + temp2 = chordl*slopel/chord(idx_strip) + temp1 = chordr*sloper/chord(idx_strip) + slopec_diff(idx_vor) = (1.-fc)*(slopel*chordl_diff+chordl* + + slopel_diff-temp2*chord_diff(idx_strip))/chord(idx_strip) + + + fc*(sloper*chordr_diff+chordr*sloper_diff-temp1* + + chord_diff(idx_strip))/chord(idx_strip) + slopec(idx_vor) = (1.-fc)*temp2 + fc*temp1 +C + temp2 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL AKIMA_D(xasec(1, iptl, isurf), xasec_diff(1, iptl, + + isurf), sasec(1, iptl, isurf), sasec_diff(1, + + iptl, isurf), nsl, (rv(1, idx_vor)-rle(1, + + idx_strip))/chord(idx_strip), (rv_diff(1, + + idx_vor)-rle_diff(1, idx_strip)-temp2* + + chord_diff(idx_strip))/chord(idx_strip), slopel + + , slopel_diff, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip + temp2 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL AKIMA_D(xasec(1, iptr, isurf), xasec_diff(1, iptr, + + isurf), sasec(1, iptr, isurf), sasec_diff(1, + + iptr, isurf), nsr, (rv(1, idx_vor)-rle(1, + + idx_strip))/chord(idx_strip), (rv_diff(1, + + idx_vor)-rle_diff(1, idx_strip)-temp2* + + chord_diff(idx_strip))/chord(idx_strip), sloper + + , sloper_diff, dsdx) +C +C Associate the panel with strip chord and component + temp2 = chordl*slopel/chord(idx_strip) + temp1 = chordr*sloper/chord(idx_strip) + slopev_diff(idx_vor) = (1.-fc)*(slopel*chordl_diff+chordl* + + slopel_diff-temp2*chord_diff(idx_strip))/chord(idx_strip) + + + fc*(sloper*chordr_diff+chordr*sloper_diff-temp1* + + chord_diff(idx_strip))/chord(idx_strip) + slopev(idx_vor) = (1.-fc)*temp2 + fc*temp1 +C + chordv_diff(idx_vor) = chord_diff(idx_strip) + chordv(idx_vor) = chord(idx_strip) +C Enforce no penetration at the control point + lvcomp(idx_vor) = lncomp(isurf) +C element inherits alpha,beta flag from surface + lvnc(idx_vor) = .true. +C +C We need to scale the control surface gains by the fraction +C of the element on the control surface + lvalbe(idx_vor) = lfalbe(isurf) +C +Cscale control gain by factor 0..1, (fraction of element on control surface) + DO n=1,ncontrol + temp2 = ((mesh_surf(1, idx_node)+mesh_surf(1, idx_node_yp1 + + ))/2-rle(1, idx_strip))/chord(idx_strip) + xpt_diff = ((mesh_surf_diff(1, idx_node)+mesh_surf_diff(1 + + , idx_node_yp1))/2-rle_diff(1, idx_strip)-temp2* + + chord_diff(idx_strip))/chord(idx_strip) + xpt = temp2 +C + temp2 = chord(idx_strip)/dxv(idx_vor) + temp1 = xled(n)/chord(idx_strip) + fracle_diff = temp2*((xled_diff(n)-temp1*chord_diff( + + idx_strip))/chord(idx_strip)-xpt_diff) + (temp1-xpt)*( + + chord_diff(idx_strip)-temp2*dxv_diff(idx_vor))/dxv( + + idx_vor) + fracle = (temp1-xpt)*temp2 +C + temp2 = chord(idx_strip)/dxv(idx_vor) + temp1 = xted(n)/chord(idx_strip) + fracte_diff = temp2*((xted_diff(n)-temp1*chord_diff( + + idx_strip))/chord(idx_strip)-xpt_diff) + (temp1-xpt)*( + + chord_diff(idx_strip)-temp2*dxv_diff(idx_vor))/dxv( + + idx_vor) + fracte = (temp1-xpt)*temp2 + IF (0.0 .LT. fracle) THEN + y1_diff = fracle_diff + y1 = fracle + ELSE + y1 = 0.0 + y1_diff = 0.D0 + END IF + IF (1.0 .GT. y1) THEN + fracle_diff = y1_diff + fracle = y1 + ELSE + fracle = 1.0 + fracle_diff = 0.D0 + END IF + IF (0.0 .LT. fracte) THEN + y2_diff = fracte_diff + y2 = fracte + ELSE + y2 = 0.0 + y2_diff = 0.D0 + END IF + IF (1.0 .GT. y2) THEN + fracte_diff = y2_diff + fracte = y2 + ELSE + fracte = 1.0 + fracte_diff = 0.D0 + END IF +C + dcontrol_diff(idx_vor, n) = gainda(n)*(fracte_diff- + + fracle_diff) + dcontrol(idx_vor, n) = gainda(n)*(fracte-fracle) +C TE control point used only if surface sheds a wake + ENDDO +C Use the cross sections to generate the OML +C nodal grid associated with vortex strip (aft-panel nodes) +C NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; +C retained in (x,z) plane at this point +C Store the panel LE mid point for the next panel in the strip +C This gets used a lot here +C We use the original input mesh (true mesh) to compute points for the OML + lvnc(idx_vor) = lfwake(isurf) +C +C +C xptxind2 = (mesh_surf(1,idx_node_yp1+1) +C & - RLE2(1,idx_strip))/CHORD2(idx_strip) +C Interpolate cross section on left side + xptxind1 = ((mesh_surf(1, idx_node+1)+mesh_surf(1, + + idx_node_yp1+1))/2-rle(1, idx_strip))/chord(idx_strip) +C +C + CALL AKIMA(xlasec(1, iptl, isurf), zlasec(1, iptl, isurf), + + nsl, xptxind1, zl_l, dsdx) +C Interpolate cross section on right side + CALL AKIMA(xuasec(1, iptl, isurf), zuasec(1, iptl, isurf), + + nsl, xptxind1, zu_l, dsdx) +C + CALL AKIMA(xlasec(1, iptr, isurf), zlasec(1, iptr, isurf), + + nsr, xptxind1, zl_r, dsdx) +C Compute the left aft node of panel +C X-point + CALL AKIMA(xuasec(1, iptr, isurf), zuasec(1, iptr, isurf), + + nsr, xptxind1, zu_r, dsdx) +C +C +C Y-point + xyn1(1, idx_vor) = rle1(1, idx_strip) + xptxind1*chord1( + + idx_strip) +C +C Interpolate z from sections to left aft node of panel + xyn1(2, idx_vor) = rle1(2, idx_strip) +C + zl = (1.-f1)*zl_l + f1*zl_r +C Store left aft z-point + zu = (1.-f1)*zu_l + f1*zu_r +C + zlon1(idx_vor) = rle1(3, idx_strip) + zl*chord1(idx_strip) +C Compute the right aft node of panel +C X-point + zupn1(idx_vor) = rle1(3, idx_strip) + zu*chord1(idx_strip) +C +C Y-point + xyn2(1, idx_vor) = rle2(1, idx_strip) + xptxind1*chord2( + + idx_strip) +C +C Interpolate z from sections to right aft node of panel + xyn2(2, idx_vor) = rle2(2, idx_strip) + zl = (1.-f2)*zl_l + f2*zl_r +C Store right aft z-point + zu = (1.-f2)*zu_l + f2*zu_r +C + zlon2(idx_vor) = rle2(3, idx_strip) + zl*chord2(idx_strip) + zupn2(idx_vor) = rle2(3, idx_strip) + zu*chord2(idx_strip) +C + idx_vor = idx_vor + 1 +C End vortex loop + ENDDO + idx_strip = idx_strip + 1 +C End strip loop +C Compute the wetted area and cave from the true mesh + ENDDO +C + sum = 0.0 + wtot = 0.0 + DO jj=1,nj(isurf) + j = jfrst(isurf) + jj - 1 + astrp = wstrip(j)*chord(j) + sum = sum + astrp + wtot = wtot + wstrip(j) + ENDDO + ssurf(isurf) = sum +C add number of strips to the global count +C + IF (wtot .EQ. 0.0) THEN + cavesurf(isurf) = 0.0 + ELSE + cavesurf(isurf) = sum/wtot + END IF +C add number of of votrices to the global count + nstrip = nstrip + nj(isurf) + nvor = nvor + nk(isurf)*nj(isurf) + END IF + END + C Differentiation of sdupl in forward (tangent) mode (with options i4 dr8 r8): -C variations of useful results: rle chord rle1 chord1 rle2 -C chord2 wstrip ainc ainc_g rv1 rv2 rv rc dxv chordv -C slopev slopec dcontrol vhinge -C with respect to varying inputs: rle chord rle1 chord1 rle2 -C chord2 wstrip ainc ainc_g rv1 rv2 rv rc dxv chordv -C slopev slopec dcontrol vhinge +C variations of useful results: rv1msh rv2msh rvmsh rcmsh rle +C chord rle1 chord1 rle2 chord2 wstrip ainc ainc_g +C rv1 rv2 rv rc dxv chordv slopev slopec dcontrol +C vhinge +C with respect to varying inputs: rv1msh rv2msh rvmsh rcmsh rle +C chord rle1 chord1 rle2 chord2 wstrip ainc ainc_g +C rv1 rv2 rv rc dxv chordv slopev slopec dcontrol +C vhinge C SUBROUTINE SDUPL_D(nn, ypt, msg) INCLUDE 'AVL.INC' @@ -1360,8 +2673,10 @@ SUBROUTINE SDUPL_D(nn, ypt, msg) lfalbe(nni) = lfalbe(nn) lfload(nni) = lfload(nn) lrange(nni) = lrange(nn) -C IFRST(NNI) = NVOR + 1 lsurfspacing(nni) = lsurfspacing(nn) + lmeshflat(nni) = lmeshflat(nn) +C IFRST(NNI) = NVOR + 1 + lsurfmsh(nni) = lsurfmsh(nn) C C---- accumulate stuff for new image surface ifrst(nni) = ifrst(nni-1) + nk(nni-1)*nj(nni-1) @@ -1430,6 +2745,7 @@ SUBROUTINE SDUPL_D(nn, ypt, msg) rle(3, jji) = rle(3, jj) chord_diff(jji) = chord_diff(jj) chord(jji) = chord(jj) + gincstrip(jji) = gincstrip(jj) wstrip_diff(jji) = wstrip_diff(jj) wstrip(jji) = wstrip(jj) tanle(jji) = -tanle(jj) @@ -1461,9 +2777,9 @@ SUBROUTINE SDUPL_D(nn, ypt, msg) phinge(1, jji, n) = phinge(1, jj, n) phinge(2, jji, n) = -phinge(2, jj, n) + yoff phinge(3, jji, n) = phinge(3, jj, n) - ENDDO C IJFRST(JJI) = NVOR + 1 C IJFRST(JJI) = IJFRST(NSTRIP - 1) + NVC(NNI) + ENDDO C C--- The defined section for image strip is flagged with (-) ijfrst(jji) = ijfrst(jji-1) + nvstrp(jji-1) @@ -1514,11 +2830,39 @@ SUBROUTINE SDUPL_D(nn, ypt, msg) slopev(iii) = slopev(ii) dxv_diff(iii) = dxv_diff(ii) dxv(iii) = dxv(ii) + dxstrpv(iii) = dxstrpv(ii) chordv_diff(iii) = chordv_diff(ii) chordv(iii) = chordv(ii) lvcomp(iii) = lncomp(nni) lvalbe(iii) = lvalbe(ii) +C Duplicate mesh data if we are using a mesh lvnc(iii) = lvnc(ii) + IF (lsurfmsh(nn)) THEN + rv1msh_diff(1, iii) = rv2msh_diff(1, ii) + rv1msh(1, iii) = rv2msh(1, ii) + rv1msh_diff(2, iii) = -rv2msh_diff(2, ii) + rv1msh(2, iii) = -rv2msh(2, ii) + yoff + rv1msh_diff(3, iii) = rv2msh_diff(3, ii) + rv1msh(3, iii) = rv2msh(3, ii) + rv2msh_diff(1, iii) = rv1msh_diff(1, ii) + rv2msh(1, iii) = rv1msh(1, ii) + rv2msh_diff(2, iii) = -rv1msh_diff(2, ii) + rv2msh(2, iii) = -rv1msh(2, ii) + yoff + rv2msh_diff(3, iii) = rv1msh_diff(3, ii) + rv2msh(3, iii) = rv1msh(3, ii) + rvmsh_diff(1, iii) = rvmsh_diff(1, ii) + rvmsh(1, iii) = rvmsh(1, ii) + rvmsh_diff(2, iii) = -rvmsh_diff(2, ii) + rvmsh(2, iii) = -rvmsh(2, ii) + yoff + rvmsh_diff(3, iii) = rvmsh_diff(3, ii) + rvmsh(3, iii) = rvmsh(3, ii) + rcmsh_diff(1, iii) = rcmsh_diff(1, ii) + rcmsh(1, iii) = rcmsh(1, ii) + rcmsh_diff(2, iii) = -rcmsh_diff(2, ii) + rcmsh(2, iii) = -rcmsh(2, ii) + yoff + rcmsh_diff(3, iii) = rcmsh_diff(3, ii) + rcmsh(3, iii) = rcmsh(3, ii) + END IF C DO n=1,ncontrol Ccc RSGN = SIGN( 1.0 , VREFL(JJ,N) ) @@ -1565,13 +2909,15 @@ SUBROUTINE SDUPL_D(nn, ypt, msg) C Differentiation of encalc in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: ess ensy ensz xsref ysref zsref C enc env enc_d -C with respect to varying inputs: ainc ainc_g rv1 rv2 rv slopev -C slopec dcontrol vhinge +C with respect to varying inputs: rv1msh rv2msh rvmsh rcmsh ainc +C ainc_g rv1 rv2 rv slopev slopec dcontrol vhinge C BDUPL C C C C +C Also checks if surface has been assigned a point cloud mesh +C and uses the real mesh to compute normals if it is SUBROUTINE ENCALC_D() INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' @@ -1580,6 +2926,8 @@ SUBROUTINE ENCALC_D() REAL ep_diff(3), eq_diff(3), es_diff(3), eb_diff(3), ec_diff(3), + ecxb_diff(3) REAL ec_g(3, ndmax), ecxb_g(3) + REAL(kind=avl_real) dchstrip, dxt, dyt, dzt, ec_msh(3) + REAL(kind=avl_real) dxt_diff, dyt_diff, dzt_diff, ec_msh_diff(3) INTEGER j INTEGER i REAL dxle @@ -1606,12 +2954,6 @@ SUBROUTINE ENCALC_D() REAL ayte_diff REAL azte REAL azte_diff - REAL dxt - REAL dxt_diff - REAL dyt - REAL dyt_diff - REAL dzt - REAL dzt_diff INTRINSIC SQRT INTEGER nv INTEGER ii @@ -1642,11 +2984,16 @@ SUBROUTINE ENCALC_D() REAL endot_diff REAL DOT REAL DOT_D - REAL arg1 - REAL arg1_diff - REAL result1 - REAL result1_diff - REAL temp + REAL(kind=avl_real) arg1 + REAL(kind=avl_real) arg1_diff + REAL(kind=avl_real) result1 + REAL(kind=avl_real) result1_diff + REAL arg10 + REAL arg10_diff + REAL(kind=avl_real) temp + REAL temp0 + REAL(kind=avl_real) temp1 + REAL(kind=avl_real) temp2 INTEGER ii1 INTEGER ii3 INTEGER ii2 @@ -1705,52 +3052,102 @@ SUBROUTINE ENCALC_D() DO ii1=1,3 ecxb_diff(ii1) = 0.D0 ENDDO + DO ii1=1,3 + ec_msh_diff(ii1) = 0.D0 + ENDDO C C...Calculate the normal vector at control points and bound vortex midpoints C +C Since we cannot seperate the encalc routine for direct mesh assignment we have to make it a branch here DO j=1,nstrip +C + IF (lsurfmsh(lssurf(j))) THEN +C Calculate normal vector for the strip (normal to X axis) +C we can't just interpolate this anymore given that +C the strip is no longer necessarily linear chordwise +C We want the spanwise unit vector for the strip at the +C chordwise location specified by SAXFR (usually set to 0.25) +C Loop over all panels in the strip until we find the one that contains +C the SAXFR position in it's projected chord. Since the panels themselves are still linear +C we can just use the bound vortex unit vector of that panel as +C the spanwise unit vector of the strip at SAXFR +C SAB: This is slow, find a better way to do this +C +C +C + dchstrip = 0.0 + searchsaxfr:DO i=ijfrst(j),ijfrst(j)+(nvstrp(j)-1) + dchstrip = dchstrip + dxstrpv(i) + IF (dchstrip .GE. chord(j)*saxfr) EXIT + ENDDO searchsaxfr +C +C + dxt_diff = rv2msh_diff(1, i) - rv1msh_diff(1, i) + dxt = rv2msh(1, i) - rv1msh(1, i) + dyt_diff = rv2msh_diff(2, i) - rv1msh_diff(2, i) + dyt = rv2msh(2, i) - rv1msh(2, i) + dzt_diff = rv2msh_diff(3, i) - rv1msh_diff(3, i) + dzt = rv2msh(3, i) - rv1msh(3, i) + xsref_diff(j) = rvmsh_diff(1, i) + xsref(j) = rvmsh(1, i) + ysref_diff(j) = rvmsh_diff(2, i) + ysref(j) = rvmsh(2, i) + zsref_diff(j) = rvmsh_diff(3, i) + zsref(j) = rvmsh(3, i) +C + ELSE +C original encalc routine for standard AVL geometry C C...Calculate normal vector for the strip (normal to X axis) - i = ijfrst(j) - dxle_diff = rv2_diff(1, i) - rv1_diff(1, i) - dxle = rv2(1, i) - rv1(1, i) - dyle_diff = rv2_diff(2, i) - rv1_diff(2, i) - dyle = rv2(2, i) - rv1(2, i) - dzle_diff = rv2_diff(3, i) - rv1_diff(3, i) - dzle = rv2(3, i) - rv1(3, i) + i = ijfrst(j) + dxle_diff = rv2_diff(1, i) - rv1_diff(1, i) + dxle = rv2(1, i) - rv1(1, i) + dyle_diff = rv2_diff(2, i) - rv1_diff(2, i) + dyle = rv2(2, i) - rv1(2, i) + dzle_diff = rv2_diff(3, i) - rv1_diff(3, i) + dzle = rv2(3, i) - rv1(3, i) C AXLE = (RV2(1,I)+RV1(1,I))*0.5 C AYLE = (RV2(2,I)+RV1(2,I))*0.5 C AZLE = (RV2(3,I)+RV1(3,I))*0.5 - axle_diff = rv_diff(1, i) - axle = rv(1, i) - ayle_diff = rv_diff(2, i) - ayle = rv(2, i) - azle_diff = rv_diff(3, i) - azle = rv(3, i) -C - i = ijfrst(j) + (nvstrp(j)-1) - dxte_diff = rv2_diff(1, i) - rv1_diff(1, i) - dxte = rv2(1, i) - rv1(1, i) - dyte_diff = rv2_diff(2, i) - rv1_diff(2, i) - dyte = rv2(2, i) - rv1(2, i) - dzte_diff = rv2_diff(3, i) - rv1_diff(3, i) - dzte = rv2(3, i) - rv1(3, i) + axle_diff = rv_diff(1, i) + axle = rv(1, i) + ayle_diff = rv_diff(2, i) + ayle = rv(2, i) + azle_diff = rv_diff(3, i) + azle = rv(3, i) +C + i = ijfrst(j) + (nvstrp(j)-1) + dxte_diff = rv2_diff(1, i) - rv1_diff(1, i) + dxte = rv2(1, i) - rv1(1, i) + dyte_diff = rv2_diff(2, i) - rv1_diff(2, i) + dyte = rv2(2, i) - rv1(2, i) + dzte_diff = rv2_diff(3, i) - rv1_diff(3, i) + dzte = rv2(3, i) - rv1(3, i) C AXTE = (RV2(1,I)+RV1(1,I))*0.5 C AYTE = (RV2(2,I)+RV1(2,I))*0.5 C AZTE = (RV2(3,I)+RV1(3,I))*0.5 - axte_diff = rv_diff(1, i) - axte = rv(1, i) - ayte_diff = rv_diff(2, i) - ayte = rv(2, i) - azte_diff = rv_diff(3, i) - azte = rv(3, i) -C - dxt_diff = (1.0-saxfr)*dxle_diff + saxfr*dxte_diff - dxt = (1.0-saxfr)*dxle + saxfr*dxte - dyt_diff = (1.0-saxfr)*dyle_diff + saxfr*dyte_diff - dyt = (1.0-saxfr)*dyle + saxfr*dyte - dzt_diff = (1.0-saxfr)*dzle_diff + saxfr*dzte_diff - dzt = (1.0-saxfr)*dzle + saxfr*dzte + axte_diff = rv_diff(1, i) + axte = rv(1, i) + ayte_diff = rv_diff(2, i) + ayte = rv(2, i) + azte_diff = rv_diff(3, i) + azte = rv(3, i) +C + dxt_diff = (1.0-saxfr)*dxle_diff + saxfr*dxte_diff + dxt = (1.0-saxfr)*dxle + saxfr*dxte + dyt_diff = (1.0-saxfr)*dyle_diff + saxfr*dyte_diff + dyt = (1.0-saxfr)*dyle + saxfr*dyte + dzt_diff = (1.0-saxfr)*dzle_diff + saxfr*dzte_diff + dzt = (1.0-saxfr)*dzle + saxfr*dzte +C + xsref_diff(j) = (1.0-saxfr)*axle_diff + saxfr*axte_diff + xsref(j) = (1.0-saxfr)*axle + saxfr*axte + ysref_diff(j) = (1.0-saxfr)*ayle_diff + saxfr*ayte_diff + ysref(j) = (1.0-saxfr)*ayle + saxfr*ayte + zsref_diff(j) = (1.0-saxfr)*azle_diff + saxfr*azte_diff + zsref(j) = (1.0-saxfr)*azle + saxfr*azte + END IF +C C arg1_diff = 2*dxt*dxt_diff + 2*dyt*dyt_diff + 2*dzt*dzt_diff arg1 = dxt*dxt + dyt*dyt + dzt*dzt @@ -1774,6 +3171,7 @@ SUBROUTINE ENCALC_D() result1 = temp ess_diff(2, j) = (dyt_diff-dyt*result1_diff/result1)/result1 ess(2, j) = dyt/result1 +C Treffz plane normals arg1_diff = 2*dxt*dxt_diff + 2*dyt*dyt_diff + 2*dzt*dzt_diff arg1 = dxt*dxt + dyt*dyt + dzt*dzt temp = SQRT(arg1) @@ -1808,14 +3206,6 @@ SUBROUTINE ENCALC_D() result1 = temp ensz_diff(j) = (dyt_diff-dyt*result1_diff/result1)/result1 ensz(j) = dyt/result1 -C - xsref_diff(j) = (1.0-saxfr)*axle_diff + saxfr*axte_diff - xsref(j) = (1.0-saxfr)*axle + saxfr*axte - ysref_diff(j) = (1.0-saxfr)*ayle_diff + saxfr*ayte_diff - ysref(j) = (1.0-saxfr)*ayle + saxfr*ayte - zsref_diff(j) = (1.0-saxfr)*azle_diff + saxfr*azte_diff - zsref(j) = (1.0-saxfr)*azle + saxfr*azte -C C es_diff(1) = 0.D0 es(1) = 0. @@ -1851,28 +3241,45 @@ SUBROUTINE ENCALC_D() enc_g(2, i, n) = 0. enc_g(3, i, n) = 0. ENDDO +C + IF (lsurfmsh(lssurf(j))) THEN +C Define unit vector along bound leg +C right h.v. pt - left h.v. pt + dxb_diff = rv2msh_diff(1, i) - rv1msh_diff(1, i) + dxb = rv2msh(1, i) - rv1msh(1, i) + dyb_diff = rv2msh_diff(2, i) - rv1msh_diff(2, i) + dyb = rv2msh(2, i) - rv1msh(2, i) + dzb_diff = rv2msh_diff(3, i) - rv1msh_diff(3, i) + dzb = rv2msh(3, i) - rv1msh(3, i) + ELSE C C...Define unit vector along bound leg C right h.v. pt - left h.v. pt - dxb_diff = rv2_diff(1, i) - rv1_diff(1, i) - dxb = rv2(1, i) - rv1(1, i) - dyb_diff = rv2_diff(2, i) - rv1_diff(2, i) - dyb = rv2(2, i) - rv1(2, i) - dzb_diff = rv2_diff(3, i) - rv1_diff(3, i) - dzb = rv2(3, i) - rv1(3, i) - arg1_diff = 2*dxb*dxb_diff + 2*dyb*dyb_diff + 2*dzb*dzb_diff - arg1 = dxb**2 + dyb**2 + dzb**2 - temp = SQRT(arg1) - IF (arg1 .EQ. 0.D0) THEN + dxb_diff = rv2_diff(1, i) - rv1_diff(1, i) + dxb = rv2(1, i) - rv1(1, i) + dyb_diff = rv2_diff(2, i) - rv1_diff(2, i) + dyb = rv2(2, i) - rv1(2, i) + dzb_diff = rv2_diff(3, i) - rv1_diff(3, i) + dzb = rv2(3, i) - rv1(3, i) + END IF + arg10_diff = 2*dxb*dxb_diff + 2*dyb*dyb_diff + 2*dzb*dzb_diff + arg10 = dxb**2 + dyb**2 + dzb**2 + temp0 = SQRT(arg10) + IF (arg10 .EQ. 0.D0) THEN emag_diff = 0.D0 ELSE - emag_diff = arg1_diff/(2.0*temp) + emag_diff = arg10_diff/(2.0*temp0) END IF - emag = temp + emag = temp0 eb_diff(1) = (dxb_diff-dxb*emag_diff/emag)/emag eb(1) = dxb/emag eb_diff(2) = (dyb_diff-dyb*emag_diff/emag)/emag eb(2) = dyb/emag +C First start by combining the contributions to the panel +C incidence from AVL incidence and camberline slope variables +C these are not actual geometric transformations of the mesh +C but rather further modifications to the chordwise vector that +C will get used to compute normals eb_diff(3) = (dzb_diff-dzb*emag_diff/emag)/emag eb(3) = dzb/emag C @@ -1893,41 +3300,139 @@ SUBROUTINE ENCALC_D() sinc = SIN(ang) cosc_diff = -(SIN(ang)*ang_diff) cosc = COS(ang) - ec_diff(1) = cosc_diff - ec(1) = cosc - ec_diff(2) = -(es(2)*sinc_diff+sinc*es_diff(2)) - ec(2) = -(sinc*es(2)) -C EC = rotation of strip normal vector? or along chord? - ec_diff(3) = -(es(3)*sinc_diff+sinc*es_diff(3)) - ec(3) = -(sinc*es(3)) +C + IF (lsurfmsh(lssurf(j))) THEN +C direct mesh assignemnt branch +C now we compute the chordwise panel vector +C note that panel`s chordwise vector has contributions +C from both the geometry itself and the incidence modification +C from the AVL AINC and camber slope variables +C Get the geometric chordwise vector using RVMSH and RCMSH which should +C be located in the same plane given that each individual panel is a +C plane +C +C + temp = rcmsh(1, i) - rvmsh(1, i) + temp1 = rcmsh(2, i) - rvmsh(2, i) + temp2 = rcmsh(3, i) - rvmsh(3, i) + arg1_diff = 2*temp*(rcmsh_diff(1, i)-rvmsh_diff(1, i)) + 2* + + temp1*(rcmsh_diff(2, i)-rvmsh_diff(2, i)) + 2*temp2*( + + rcmsh_diff(3, i)-rvmsh_diff(3, i)) + arg1 = temp*temp + temp1*temp1 + temp2*temp2 + temp2 = SQRT(arg1) + IF (arg1 .EQ. 0.D0) THEN + emag_diff = 0.D0 + ELSE + emag_diff = arg1_diff/(2.0*temp2) + END IF + emag = temp2 + temp2 = (rcmsh(1, i)-rvmsh(1, i))/emag + ec_msh_diff(1) = (rcmsh_diff(1, i)-rvmsh_diff(1, i)-temp2* + + emag_diff)/emag + ec_msh(1) = temp2 + temp2 = (rcmsh(2, i)-rvmsh(2, i))/emag + ec_msh_diff(2) = (rcmsh_diff(2, i)-rvmsh_diff(2, i)-temp2* + + emag_diff)/emag + ec_msh(2) = temp2 +C Now we have to rotate this vector by the incidence contribution from AINC and CAMBER +C However, this rotation needs to be done about the local y-axis of the wing +C Earlier we computed ES the normal vector of the strip projected to the Trefftz plane +C The axis we need to rotate about is the one purpendicular to this ES. +C As a result all panel normals in a given strip will be rotated about the same axis defined by the that strip +C The components of the rotation axis are obtained from ES as follows +C rot_axis(1) = 0 +C rot_axis(2) = -ES(3) +C rot_axis(3) = ES(2) +C We can then multiply ec_msh by the rotation matrix for a rotation about an arbitrary axis +C see https://pubs.aip.org/aapt/ajp/article/44/1/63/1050167/Formalism-for-the-rotation-matrix-of-rotations +C Note that standard AVL also does this exact same thing but since they always rotate the vector [1,0,0] +C the result collapses into the ridiculously simple expression for EC that you see in the other branch + temp2 = (rcmsh(3, i)-rvmsh(3, i))/emag + ec_msh_diff(3) = (rcmsh_diff(3, i)-rvmsh_diff(3, i)-temp2* + + emag_diff)/emag + ec_msh(3) = temp2 +C +C + ec_diff(1) = ec_msh(1)*cosc_diff + cosc*ec_msh_diff(1) + + + ec_msh(2)*(sinc*es_diff(2)+es(2)*sinc_diff) + es(2)*sinc* + + ec_msh_diff(2) + ec_msh(3)*(sinc*es_diff(3)+es(3)* + + sinc_diff) + es(3)*sinc*ec_msh_diff(3) + ec(1) = cosc*ec_msh(1) + es(2)*sinc*ec_msh(2) + es(3)*sinc* + + ec_msh(3) + temp0 = es(3)*es(3)*(-cosc+1) + cosc + ec_diff(2) = ec_msh(2)*((1-cosc)*2*es(3)*es_diff(3)-(es(3)** + + 2-1.0)*cosc_diff) + temp0*ec_msh_diff(2) - sinc*es_diff(2) + + - es(2)*sinc_diff - (1-cosc)*ec_msh(3)*(es(3)*es_diff(2)+ + + es(2)*es_diff(3)) - es(2)*es(3)*((1-cosc)*ec_msh_diff(3)- + + ec_msh(3)*cosc_diff) + ec(2) = temp0*ec_msh(2) - es(2)*sinc - es(2)*es(3)*((1-cosc) + + *ec_msh(3)) + temp0 = es(2)*es(2)*(-cosc+1) + cosc + ec_diff(3) = ec_msh(3)*((1-cosc)*2*es(2)*es_diff(2)-(es(2)** + + 2-1.0)*cosc_diff) + temp0*ec_msh_diff(3) - (1-cosc)*ec_msh + + (2)*(es(3)*es_diff(2)+es(2)*es_diff(3)) - es(2)*es(3)*((1- + + cosc)*ec_msh_diff(2)-ec_msh(2)*cosc_diff) - ec_msh(1)*( + + sinc*es_diff(3)+es(3)*sinc_diff) - es(3)*sinc*ec_msh_diff( + + 1) + ec(3) = temp0*ec_msh(3) - es(2)*es(3)*((1-cosc)*ec_msh(2)) - + + es(3)*sinc*ec_msh(1) +C + ELSE + ec_diff(1) = cosc_diff + ec(1) = cosc + ec_diff(2) = -(es(2)*sinc_diff+sinc*es_diff(2)) + ec(2) = -(sinc*es(2)) + ec_diff(3) = -(es(3)*sinc_diff+sinc*es_diff(3)) + ec(3) = -(sinc*es(3)) + END IF +C +C The derivative here also changes if we use a custom mesh +C Note the derivative is only wrt to AVL incidence vars +C as those are the vars AVL DVs can support DO n=1,ndesign - ec_g(1, n) = -(sinc*ainc_g(j, n)) - ec_g(2, n) = -(cosc*es(2)*ainc_g(j, n)) - ec_g(3, n) = -(cosc*es(3)*ainc_g(j, n)) + IF (lsurfmsh(lssurf(j))) THEN + ec_g(1, n) = (-(sinc*ec_msh(1))+es(2)*cosc*ec_msh(2)+es(3) + + *cosc*ec_msh(3))*ainc_g(j, n) + ec_g(2, n) = (-(es(2)*cosc)+(es(3)**2*(1+sinc)-sinc)* + + ec_msh(2)-es(2)*es(3)*(1+sinc)*ec_msh(3))*ainc_g(j, n) + ec_g(3, n) = (-(es(3)*cosc*ec_msh(1))-es(2)*es(3)*(1+sinc) + + *ec_msh(2)+(es(2)**2*(1+sinc)-sinc)*ec_msh(3))*ainc_g(j + + , n) +C + ELSE + ec_g(1, n) = -(sinc*ainc_g(j, n)) + ec_g(2, n) = -(cosc*es(2)*ainc_g(j, n)) + ec_g(3, n) = -(cosc*es(3)*ainc_g(j, n)) + END IF ENDDO C C...Normal vector is perpendicular to camberline vector and to the bound leg CALL CROSS_D(ec, ec_diff, eb, eb_diff, ecxb, ecxb_diff) - arg1_diff = 2*ecxb(1)*ecxb_diff(1) + 2*ecxb(2)*ecxb_diff(2) + + arg10_diff = 2*ecxb(1)*ecxb_diff(1) + 2*ecxb(2)*ecxb_diff(2) + + 2*ecxb(3)*ecxb_diff(3) - arg1 = ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 - temp = SQRT(arg1) - IF (arg1 .EQ. 0.D0) THEN + arg10 = ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 + temp0 = SQRT(arg10) + IF (arg10 .EQ. 0.D0) THEN emag_diff = 0.D0 ELSE - emag_diff = arg1_diff/(2.0*temp) + emag_diff = arg10_diff/(2.0*temp0) END IF - emag = temp + emag = temp0 +C This section is identical to the normal vector at the control +C point. The only different is that the AVL camberline slope +C is taken at the bound vortex point rather than the control point +C the geometric contributions to the normal vector at both of these +C point is identical as the lie in the plane of the same panel. IF (emag .NE. 0.0) THEN - temp = ecxb(1)/emag - enc_diff(1, i) = (ecxb_diff(1)-temp*emag_diff)/emag - enc(1, i) = temp - temp = ecxb(2)/emag - enc_diff(2, i) = (ecxb_diff(2)-temp*emag_diff)/emag - enc(2, i) = temp - temp = ecxb(3)/emag - enc_diff(3, i) = (ecxb_diff(3)-temp*emag_diff)/emag - enc(3, i) = temp + temp0 = ecxb(1)/emag + enc_diff(1, i) = (ecxb_diff(1)-temp0*emag_diff)/emag + enc(1, i) = temp0 + temp0 = ecxb(2)/emag + enc_diff(2, i) = (ecxb_diff(2)-temp0*emag_diff)/emag + enc(2, i) = temp0 + temp0 = ecxb(3)/emag + enc_diff(3, i) = (ecxb_diff(3)-temp0*emag_diff)/emag + enc(3, i) = temp0 DO n=1,ndesign CALL CROSS(ec_g(1, n), eb, ecxb_g) emag_g = enc(1, i)*ecxb_g(1) + enc(2, i)*ecxb_g(2) + enc(3 @@ -1963,40 +3468,85 @@ SUBROUTINE ENCALC_D() sinc = SIN(ang) cosc_diff = -(SIN(ang)*ang_diff) cosc = COS(ang) - ec_diff(1) = cosc_diff - ec(1) = cosc - ec_diff(2) = -(es(2)*sinc_diff+sinc*es_diff(2)) - ec(2) = -(sinc*es(2)) - ec_diff(3) = -(es(3)*sinc_diff+sinc*es_diff(3)) - ec(3) = -(sinc*es(3)) + IF (lsurfmsh(lssurf(j))) THEN +C direct mesh assignment branch +C see explanation in section above for control point normals +C ec_msh was already computed in that section + ec_diff(1) = ec_msh(1)*cosc_diff + cosc*ec_msh_diff(1) + + + ec_msh(2)*(sinc*es_diff(2)+es(2)*sinc_diff) + es(2)*sinc* + + ec_msh_diff(2) + ec_msh(3)*(sinc*es_diff(3)+es(3)* + + sinc_diff) + es(3)*sinc*ec_msh_diff(3) + ec(1) = cosc*ec_msh(1) + es(2)*sinc*ec_msh(2) + es(3)*sinc* + + ec_msh(3) + temp0 = es(3)*es(3)*(-cosc+1) + cosc + ec_diff(2) = ec_msh(2)*((1-cosc)*2*es(3)*es_diff(3)-(es(3)** + + 2-1.0)*cosc_diff) + temp0*ec_msh_diff(2) - sinc*es_diff(2) + + - es(2)*sinc_diff - (1-cosc)*ec_msh(3)*(es(3)*es_diff(2)+ + + es(2)*es_diff(3)) - es(2)*es(3)*((1-cosc)*ec_msh_diff(3)- + + ec_msh(3)*cosc_diff) + ec(2) = temp0*ec_msh(2) - es(2)*sinc - es(2)*es(3)*((1-cosc) + + *ec_msh(3)) + temp0 = es(2)*es(2)*(-cosc+1) + cosc + ec_diff(3) = ec_msh(3)*((1-cosc)*2*es(2)*es_diff(2)-(es(2)** + + 2-1.0)*cosc_diff) + temp0*ec_msh_diff(3) - (1-cosc)*ec_msh + + (2)*(es(3)*es_diff(2)+es(2)*es_diff(3)) - es(2)*es(3)*((1- + + cosc)*ec_msh_diff(2)-ec_msh(2)*cosc_diff) - ec_msh(1)*( + + sinc*es_diff(3)+es(3)*sinc_diff) - es(3)*sinc*ec_msh_diff( + + 1) + ec(3) = temp0*ec_msh(3) - es(2)*es(3)*((1-cosc)*ec_msh(2)) - + + es(3)*sinc*ec_msh(1) +C + ELSE + ec_diff(1) = cosc_diff + ec(1) = cosc + ec_diff(2) = -(es(2)*sinc_diff+sinc*es_diff(2)) + ec(2) = -(sinc*es(2)) + ec_diff(3) = -(es(3)*sinc_diff+sinc*es_diff(3)) + ec(3) = -(sinc*es(3)) + END IF +C DO n=1,ndesign - ec_g(1, n) = -(sinc*ainc_g(j, n)) - ec_g(2, n) = -(cosc*es(2)*ainc_g(j, n)) - ec_g(3, n) = -(cosc*es(3)*ainc_g(j, n)) + IF (lsurfmsh(lssurf(j))) THEN +C Direct mesh assignment branch + ec_g(1, n) = (-(sinc*ec_msh(1))+es(2)*cosc*ec_msh(2)+es(3) + + *cosc*ec_msh(3))*ainc_g(j, n) + ec_g(2, n) = (-(es(2)*cosc)+(es(3)**2*(1+sinc)-sinc)* + + ec_msh(2)-es(2)*es(3)*(1+sinc)*ec_msh(3))*ainc_g(j, n) + ec_g(3, n) = (-(es(3)*cosc*ec_msh(1))-es(2)*es(3)*(1+sinc) + + *ec_msh(2)+(es(2)**2*(1+sinc)-sinc)*ec_msh(3))*ainc_g(j + + , n) +C + ELSE + ec_g(1, n) = -(sinc*ainc_g(j, n)) + ec_g(2, n) = -(cosc*es(2)*ainc_g(j, n)) + ec_g(3, n) = -(cosc*es(3)*ainc_g(j, n)) + END IF ENDDO C C...Normal vector is perpendicular to camberline vector and to the bound leg CALL CROSS_D(ec, ec_diff, eb, eb_diff, ecxb, ecxb_diff) - arg1_diff = 2*ecxb(1)*ecxb_diff(1) + 2*ecxb(2)*ecxb_diff(2) + + arg10_diff = 2*ecxb(1)*ecxb_diff(1) + 2*ecxb(2)*ecxb_diff(2) + + 2*ecxb(3)*ecxb_diff(3) - arg1 = ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 - temp = SQRT(arg1) - IF (arg1 .EQ. 0.D0) THEN + arg10 = ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 + temp0 = SQRT(arg10) + IF (arg10 .EQ. 0.D0) THEN emag_diff = 0.D0 ELSE - emag_diff = arg1_diff/(2.0*temp) + emag_diff = arg10_diff/(2.0*temp0) END IF - emag = temp + emag = temp0 +C this is a pure rotation of the normal vector +C the geometric contribution from the mesh is already accounted for IF (emag .NE. 0.0) THEN - temp = ecxb(1)/emag - env_diff(1, i) = (ecxb_diff(1)-temp*emag_diff)/emag - env(1, i) = temp - temp = ecxb(2)/emag - env_diff(2, i) = (ecxb_diff(2)-temp*emag_diff)/emag - env(2, i) = temp - temp = ecxb(3)/emag - env_diff(3, i) = (ecxb_diff(3)-temp*emag_diff)/emag - env(3, i) = temp + temp0 = ecxb(1)/emag + env_diff(1, i) = (ecxb_diff(1)-temp0*emag_diff)/emag + env(1, i) = temp0 + temp0 = ecxb(2)/emag + env_diff(2, i) = (ecxb_diff(2)-temp0*emag_diff)/emag + env(2, i) = temp0 + temp0 = ecxb(3)/emag + env_diff(3, i) = (ecxb_diff(3)-temp0*emag_diff)/emag + env(3, i) = temp0 DO n=1,ndesign CALL CROSS(ec_g(1, n), eb, ecxb_g) emag_g = enc(1, i)*ecxb_g(1) + enc(2, i)*ecxb_g(2) + enc(3 @@ -2104,5 +3654,4 @@ SUBROUTINE ENCALC_D() RETURN END C ENCALC -C diff --git a/src/ad_src/forward_ad_src/amode_d.f b/src/ad_src/forward_ad_src/amode_d.f index 623dfa5..80de7fd 100644 --- a/src/ad_src/forward_ad_src/amode_d.f +++ b/src/ad_src/forward_ad_src/amode_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of set_params in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: mach @@ -8,7 +8,6 @@ C C SUBROUTINE SET_PARAMS_D(ir) -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER ir @@ -55,5 +54,6 @@ SUBROUTINE SET_PARAMS_D(ir) rixy = parval(ipixy, ir) riyz = parval(ipiyz, ir) rizx = parval(ipizx, ir) +C END diff --git a/src/ad_src/forward_ad_src/aoper_d.f b/src/ad_src/forward_ad_src/aoper_d.f index 511c0cf..50d41ba 100644 --- a/src/ad_src/forward_ad_src/aoper_d.f +++ b/src/ad_src/forward_ad_src/aoper_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of calc_stab_derivs in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: cxtot_u_ba cytot_u_ba cztot_u_ba @@ -55,9 +55,9 @@ SUBROUTINE CALC_STAB_DERIVS_D() INTEGER ii1 REAL(kind=avl_real) temp C - CALL GETSA(lnasa_sa, satype, dir) C CALL VINFAB C CALL AERO + CALL GETSA(lnasa_sa, satype, dir) C C---- set freestream velocity components from alpha, beta C @@ -577,8 +577,8 @@ SUBROUTINE CALC_STAB_DERIVS_D() cmtot_d_ba(k) = cmtot_d(2, k) cntot_d_ba_diff(k) = dir*cmtot_d_diff(3, k) cntot_d_ba(k) = dir*cmtot_d(3, k) - ENDDO C design variables + ENDDO DO k=1,ndesign cxtot_g_ba(k) = dir*cftot_g(1, k) cytot_g_ba(k) = cftot_g(2, k) @@ -612,7 +612,6 @@ SUBROUTINE CALC_STAB_DERIVS_D() C C ======================== res and Adjoint for GAM ======== SUBROUTINE GET_RES_D() -C use avl_heap_inc use avl_heap_diff_inc INCLUDE 'AVL.INC' @@ -630,11 +629,11 @@ SUBROUTINE GET_RES_D() REAL(kind=avl_real) temp INTEGER ii1 INTEGER ii2 - CALL SET_PAR_AND_CONS_D(nitmax, irun) C Do not use this routine in the sovler C IF(.NOT.LAIC) THEN C CALL build_AIC C end if + CALL SET_PAR_AND_CONS_D(nitmax, irun) C--- CALL BUILD_AIC_D() amach_diff = mach_diff @@ -700,12 +699,14 @@ SUBROUTINE GET_RES_D() ENDDO CALL SET_VEL_RHS_D() C +C$AD II-LOOP CALL MAT_PROD_D(aicn, aicn_diff, gam, gam_diff, nvor, res, + res_diff) C---- add the RHS vector to the residual DO i=1,nvor res_diff(i) = res_diff(i) - rhs_diff(i) res(i) = res(i) - rhs(i) +C$AD II-LOOP ENDDO DO ii1=1,ndmax DO ii2=1,nvor @@ -718,9 +719,10 @@ SUBROUTINE GET_RES_D() DO ic=1,ncontrol C------ don't bother if this control variable is undefined IF (lcondef(ic)) THEN +C RHS_D(:) = 0.D0 CALL MAT_PROD_D(aicn, aicn_diff, gam_d(:, ic), gam_d_diff(:, + ic), nvor, res_d(:, ic), res_d_diff(:, ic)) -C RHS_D(:) = 0.D0 +C$AD II-LOOP CALL SET_GAM_D_RHS_D(ic, enc_d, enc_d_diff, rhs_d, rhs_d_diff) DO i=1,nvor res_d_diff(i, ic) = res_d_diff(i, ic) - rhs_d_diff(i) @@ -728,5 +730,7 @@ SUBROUTINE GET_RES_D() ENDDO END IF ENDDO +C + END diff --git a/src/ad_src/forward_ad_src/asetup_d.f b/src/ad_src/forward_ad_src/asetup_d.f index 94ef1ec..da329fa 100644 --- a/src/ad_src/forward_ad_src/asetup_d.f +++ b/src/ad_src/forward_ad_src/asetup_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of build_aic in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: aicn @@ -245,9 +245,10 @@ SUBROUTINE VELSUM_D() wc_g(k, i, n) = vc_g(k, i, n) wv_g(k, i, n) = vv_g(k, i, n) ENDDO +C + ENDDO ENDDO -C C RETURN END @@ -266,8 +267,8 @@ SUBROUTINE SET_PAR_AND_CONS_D(niter, ir) INTEGER iv INTEGER ic INTEGER ii1 - CALL SET_PARAMS_D(ir) C Additionally set the reference point to be at the cg + CALL SET_PARAMS_D(ir) xyzref_diff(1) = parval_diff(ipxcg, ir) xyzref(1) = parval(ipxcg, ir) xyzref_diff(2) = parval_diff(ipycg, ir) @@ -350,7 +351,6 @@ SUBROUTINE SET_PAR_AND_CONS_D(niter, ir) C with respect to varying inputs: vinf wrot delcon xyzref rc C enc enc_d wcsrd_u SUBROUTINE SET_VEL_RHS_D() -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' REAL rrot(3), vunit(3), vunit_w_term(3), wunit(3) @@ -464,6 +464,8 @@ SUBROUTINE SET_VEL_RHS_D() rhs(i) = 0 END IF ENDDO +C + END C Differentiation of set_vel_rhs_u in forward (tangent) mode (with options i4 dr8 r8): diff --git a/src/ad_src/forward_ad_src/atpforc_d.f b/src/ad_src/forward_ad_src/atpforc_d.f index 54d7414..1dddf93 100644 --- a/src/ad_src/forward_ad_src/atpforc_d.f +++ b/src/ad_src/forward_ad_src/atpforc_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of tpforc in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: clff cyff cdff spanef @@ -92,9 +92,8 @@ SUBROUTINE TPFORC_D() REAL arg1_diff REAL temp REAL temp0 - REAL(kind=8) temp1 + REAL(kind=avl_real) temp1 REAL(kind=avl_real) temp2 - REAL(kind=8) temp3 INTEGER ii1 INTEGER ii2 C @@ -160,6 +159,8 @@ SUBROUTINE TPFORC_D() gams_g(jc, n) = gams_g(jc, n) + gam_g(i, n) ENDDO ENDDO +Ccc ENDIF + ENDDO DO ii1=1,NSTRIP DO ii2=1,3 @@ -176,7 +177,6 @@ SUBROUTINE TPFORC_D() rt1_diff(ii2, ii1) = 0.D0 ENDDO ENDDO -Ccc ENDIF C C---- set x,y,z in wind axes (Y,Z are then in Trefftz plane) DO jc=1,nstrip @@ -237,17 +237,18 @@ SUBROUTINE TPFORC_D() C C...Sum velocity contributions from wake vortices DO jv=1,nstrip - arg1_diff = 2*(rt2(2, jv)-rt1(2, jv))*(rt2_diff(2, jv)- - + rt1_diff(2, jv)) + 2*(rt2(3, jv)-rt1(3, jv))*(rt2_diff(3, jv - + )-rt1_diff(3, jv)) - arg1 = (rt2(2, jv)-rt1(2, jv))**2 + (rt2(3, jv)-rt1(3, jv))**2 - temp = SQRT(arg1) + temp = rt2(2, jv) - rt1(2, jv) + temp0 = rt2(3, jv) - rt1(3, jv) + arg1_diff = 2*temp*(rt2_diff(2, jv)-rt1_diff(2, jv)) + 2*temp0 + + *(rt2_diff(3, jv)-rt1_diff(3, jv)) + arg1 = temp*temp + temp0*temp0 + temp0 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN dsyz_diff = 0.D0 ELSE - dsyz_diff = arg1_diff/(2.0*temp) + dsyz_diff = arg1_diff/(2.0*temp0) END IF - dsyz = temp + dsyz = temp0 IF (lncomp(lssurf(jc)) .EQ. lncomp(lssurf(jv))) THEN Ccc RCORE = 0.0001*DSYZ rcore = 0. @@ -268,38 +269,40 @@ SUBROUTINE TPFORC_D() dz1 = zcntr - rt1(3, jv) dz2_diff = zcntr_diff - rt2_diff(3, jv) dz2 = zcntr - rt2(3, jv) - arg1_diff = 2*(dy1**2+dz1**2)*(2*dy1*dy1_diff+2*dz1*dz1_diff) - + + 4*rcore**3*rcore_diff - arg1 = (dy1**2+dz1**2)**2 + rcore**4 - temp = SQRT(arg1) + temp0 = dy1*dy1 + dz1*dz1 + arg1_diff = 2*temp0*(2*dy1*dy1_diff+2*dz1*dz1_diff) + 4*rcore + + **3*rcore_diff + arg1 = temp0*temp0 + rcore**4 + temp0 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN rsq1_diff = 0.D0 ELSE - rsq1_diff = arg1_diff/(2.0*temp) + rsq1_diff = arg1_diff/(2.0*temp0) END IF - rsq1 = temp - arg1_diff = 2*(dy2**2+dz2**2)*(2*dy2*dy2_diff+2*dz2*dz2_diff) - + + 4*rcore**3*rcore_diff - arg1 = (dy2**2+dz2**2)**2 + rcore**4 - temp = SQRT(arg1) + rsq1 = temp0 + temp0 = dy2*dy2 + dz2*dz2 + arg1_diff = 2*temp0*(2*dy2*dy2_diff+2*dz2*dz2_diff) + 4*rcore + + **3*rcore_diff + arg1 = temp0*temp0 + rcore**4 + temp0 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN rsq2_diff = 0.D0 ELSE - rsq2_diff = arg1_diff/(2.0*temp) + rsq2_diff = arg1_diff/(2.0*temp0) END IF - rsq2 = temp + rsq2 = temp0 Cc RSQ1 = DY1*DY1 + DZ1*DZ1 + RCORE**2 Cc RSQ2 = DY2*DY2 + DZ2*DZ2 + RCORE**2 - temp = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff + hpi*(temp*gams_diff(jv)+gams(jv)*(( + temp0 = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff + hpi*(temp0*gams_diff(jv)+gams(jv)*(( + dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2*rsq2_diff/ + rsq2)/rsq2)) - vy = vy + hpi*(gams(jv)*temp) - temp = dy2/rsq2 - dy1/rsq1 - vz_diff = vz_diff + hpi*(temp*gams_diff(jv)+gams(jv)*(( + vy = vy + hpi*(gams(jv)*temp0) + temp0 = dy2/rsq2 - dy1/rsq1 + vz_diff = vz_diff + hpi*(temp0*gams_diff(jv)+gams(jv)*(( + dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1*rsq1_diff/ + rsq1)/rsq1)) - vz = vz + hpi*(gams(jv)*temp) + vz = vz + hpi*(gams(jv)*temp0) DO n=1,numax vy_u(n) = vy_u(n) + hpi*gams_u(jv, n)*(dz1/rsq1-dz2/rsq2) vz_u(n) = vz_u(n) + hpi*gams_u(jv, n)*(-(dy1/rsq1)+dy2/rsq2) @@ -328,16 +331,16 @@ SUBROUTINE TPFORC_D() rsq1 = dy1*dy1 + dz1*dz1 rsq2_diff = 2*dy2*dy2_diff + 2*dz2*dz2_diff rsq2 = dy2*dy2 + dz2*dz2 - temp = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff - hpi*izsym*(temp*gams_diff(jv)+gams(jv)*( - + (dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2*rsq2_diff - + /rsq2)/rsq2)) - vy = vy - hpi*izsym*(gams(jv)*temp) - temp = dy2/rsq2 - dy1/rsq1 - vz_diff = vz_diff - hpi*izsym*(temp*gams_diff(jv)+gams(jv)*( - + (dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1*rsq1_diff - + /rsq1)/rsq1)) - vz = vz - hpi*izsym*(gams(jv)*temp) + temp0 = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff - hpi*izsym*(temp0*gams_diff(jv)+gams(jv)* + + ((dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2* + + rsq2_diff/rsq2)/rsq2)) + vy = vy - hpi*izsym*(gams(jv)*temp0) + temp0 = dy2/rsq2 - dy1/rsq1 + vz_diff = vz_diff - hpi*izsym*(temp0*gams_diff(jv)+gams(jv)* + + ((dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1* + + rsq1_diff/rsq1)/rsq1)) + vz = vz - hpi*izsym*(gams(jv)*temp0) DO n=1,numax vy_u(n) = vy_u(n) - hpi*gams_u(jv, n)*(dz1/rsq1-dz2/rsq2)* + izsym @@ -371,16 +374,16 @@ SUBROUTINE TPFORC_D() rsq1 = dy1*dy1 + dz1*dz1 rsq2_diff = 2*dy2*dy2_diff + 2*dz2*dz2_diff rsq2 = dy2*dy2 + dz2*dz2 - temp = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff - hpi*iysym*(temp*gams_diff(jv)+gams(jv)*( - + (dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2*rsq2_diff - + /rsq2)/rsq2)) - vy = vy - hpi*iysym*(gams(jv)*temp) - temp = dy2/rsq2 - dy1/rsq1 - vz_diff = vz_diff - hpi*iysym*(temp*gams_diff(jv)+gams(jv)*( - + (dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1*rsq1_diff - + /rsq1)/rsq1)) - vz = vz - hpi*iysym*(gams(jv)*temp) + temp0 = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff - hpi*iysym*(temp0*gams_diff(jv)+gams(jv)* + + ((dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2* + + rsq2_diff/rsq2)/rsq2)) + vy = vy - hpi*iysym*(gams(jv)*temp0) + temp0 = dy2/rsq2 - dy1/rsq1 + vz_diff = vz_diff - hpi*iysym*(temp0*gams_diff(jv)+gams(jv)* + + ((dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1* + + rsq1_diff/rsq1)/rsq1)) + vz = vz - hpi*iysym*(gams(jv)*temp0) DO n=1,numax vy_u(n) = vy_u(n) - hpi*gams_u(jv, n)*(dz1/rsq1-dz2/rsq2)* + iysym @@ -415,12 +418,12 @@ SUBROUTINE TPFORC_D() rsq1 = dy1*dy1 + dz1*dz1 rsq2_diff = 2*dy2*dy2_diff + 2*dz2*dz2_diff rsq2 = dy2*dy2 + dz2*dz2 - temp = hpi*iysym*izsym - temp0 = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff + temp*(temp0*gams_diff(jv)+gams(jv)*(( + temp0 = hpi*iysym*izsym + temp = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff + temp0*(temp*gams_diff(jv)+gams(jv)*(( + dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2* + rsq2_diff/rsq2)/rsq2)) - vy = vy + temp*(gams(jv)*temp0) + vy = vy + temp0*(gams(jv)*temp) temp0 = hpi*iysym*izsym temp = dy2/rsq2 - dy1/rsq1 vz_diff = vz_diff + temp0*(temp*gams_diff(jv)+gams(jv)*(( @@ -523,9 +526,9 @@ SUBROUTINE TPFORC_D() C--------------------------------------------------------- C C---- aspect ratio - temp2 = bref*bref/sref - ar_diff = (2*bref*bref_diff-temp2*sref_diff)/sref - ar = temp2 + temp1 = bref*bref/sref + ar_diff = (2*bref*bref_diff-temp1*sref_diff)/sref + ar = temp1 C C---- span efficiency IF (cdff .EQ. 0.0) THEN @@ -544,10 +547,10 @@ SUBROUTINE TPFORC_D() ELSE C temp1 = pi*ar*cdff - temp3 = (clff*clff+cyff*cyff)/temp1 - spanef_diff = (2*clff*clff_diff+2*cyff*cyff_diff-temp3*(cdff*pi* + temp2 = (clff*clff+cyff*cyff)/temp1 + spanef_diff = (2*clff*clff_diff+2*cyff*cyff_diff-temp2*(cdff*pi* + ar_diff+pi*ar*cdff_diff))/temp1 - spanef = temp3 + spanef = temp2 spanef_cl = 2.0*clff/(pi*ar*cdff) spanef_cy = 2.0*cyff/(pi*ar*cdff) spanef_cd = -(spanef/cdff) diff --git a/src/ad_src/forward_ad_src/cdcl_d.f b/src/ad_src/forward_ad_src/cdcl_d.f index cf7d1b6..d1a2859 100644 --- a/src/ad_src/forward_ad_src/cdcl_d.f +++ b/src/ad_src/forward_ad_src/cdcl_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of cdcl in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: cd_cl cd diff --git a/src/ad_src/forward_ad_src/sgutil_d.f b/src/ad_src/forward_ad_src/sgutil_d.f index 9bc346e..3bb392a 100644 --- a/src/ad_src/forward_ad_src/sgutil_d.f +++ b/src/ad_src/forward_ad_src/sgutil_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of akima in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: yy @@ -290,6 +290,24 @@ SUBROUTINE AKIMA_D(x, x_diff, y, y_diff, n, xx, xx_diff, yy, C C C +C This is a extremely important funciton that is not +C documented for some reason. +C Inputs: +C NVC: NUMBER OF DESIRED POINTS IN ARRAY +C CSPACE: SPACING PARAMETER (-3<=PSPACE<=3). +C DEFINES POINT DISTRIBUTION +C TO BE USED AS FOLLOWS: +C PSPACE = 0 : EQUAL SPACING +C PSPACE = 1 : COSINE SPACING. +C PSPACE = 2 : SINE SPACING +C (CONCENTRATING POINTS NEAR 0). +C PSPACE = 3 : EQUAL SPACING. +C CLAF: CL alfa (needed to determine control point location) +C Outputs: +C XPT: Array of panel leading edge x-locations +C XVR: Array of vortex x-locations +C XSR: Array of source x-locations +C XCP: Array of control point x-locations SUBROUTINE CSPACER_D(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, + xcp, xcp_diff) REAL xpt(*), xvr(*), xsr(*), xcp(*) @@ -342,6 +360,8 @@ SUBROUTINE CSPACER_D(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, acsp = -cspace END IF ncsp = INT(acsp) +C Each of these provides a quarter panel chord offset for cosine, +C sine, and uniform spacing respectively. IF (ncsp .EQ. 0) THEN f0 = 1.0 - acsp f1 = acsp @@ -363,10 +383,16 @@ SUBROUTINE CSPACER_D(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, C DO ivc=1,nvc C------ uniform +C eqv (IVC-1)/NVC xc0 = INT(4*ivc-4)*dxc0 xpt0 = xc0 +C quarter-chord xvr0 = xc0 + dxc0 +C half-chord xsr0 = xc0 + 2.0*dxc0 +C quarter-chord + half-chord*claf +C Note: claf is a scaling factor so typically claf = 1 and the control point +C is at the three-quarter chord position of the panel xcp0_diff = dxc0*2.0*claf_diff xcp0 = xc0 + dxc0 + 2.0*dxc0*claf C @@ -408,8 +434,8 @@ SUBROUTINE CSPACER_D(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, xsr(ivc) = f0*xsr0 + f1*xsr1 + f2*xsr2 xcp_diff(ivc) = f0*xcp0_diff + f1*xcp1_diff + f2*xcp2_diff xcp(ivc) = f0*xcp0 + f1*xcp1 + f2*xcp2 - ENDDO C + ENDDO xpt(1) = 0.0 xpt(nvc+1) = 1.0 C diff --git a/src/ad_src/reverse_ad_src/aero_b.f b/src/ad_src/reverse_ad_src/aero_b.f index d9f76a2..53a68e0 100644 --- a/src/ad_src/reverse_ad_src/aero_b.f +++ b/src/ad_src/reverse_ad_src/aero_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of aero in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: clff cyff cdff spanef cdtot @@ -102,9 +102,9 @@ SUBROUTINE AERO_B() REAL dir EXTERNAL GETSA INTEGER is - REAL(kind=8) temp - REAL(kind=8) temp_diff - INTEGER branch + REAL(kind=avl_real) temp + REAL(kind=avl_real) temp_diff + INTEGER*4 branch INTEGER ii1 C cdtot = 0. @@ -584,10 +584,10 @@ SUBROUTINE SFFORC_B() REAL result2 REAL temp_diff INTEGER ii1 - INTEGER branch + INTEGER*4 branch REAL temp_diff0 REAL temp_diff1 - REAL(kind=8) temp_diff2 + REAL(kind=avl_real) temp_diff2 REAL(kind=avl_real) temp_diff3 INTEGER ii2 INTEGER ii3 @@ -699,6 +699,13 @@ SUBROUTINE SFFORC_B() DO n=1,numax ulift_u(k, n) = (ulift_u(k, n)-ulift(k)*ulmag_u(n))/ulmag ENDDO +C write(6,*) 'Strip J ',J +C write(6,*) 'UDRAG ',UDRAG +C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG +C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) +C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) +C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) + ENDDO END IF C @@ -1534,10 +1541,6 @@ SUBROUTINE SFFORC_B() C XXSURF values normalized to configuration reference quantities SREF,CREF,BREF about XYZref C XX_LSRF values normalized to each surface's reference quantities (area and average chord) DO is=1,nsurf - CALL PUSHINTEGER4(l) - CALL PUSHINTEGER4(j) - CALL PUSHREAL8(sr) - CALL PUSHREAL8(cr) C C--- Surface hinge moments defined by surface LE moment about hinge vector Ccc CMLE_LSRF(IS) = DOT(CM_LSRF(1,IS),VHINGE(1,IS)) @@ -1784,134 +1787,134 @@ SUBROUTINE SFFORC_B() sr_diff = 0.D0 cr_diff = 0.D0 DO n=ncontrol,1,-1 - temp_diff2 = cms_d_diff(3, is, n)/(sref*bref) + temp_diff3 = cms_d_diff(3, is, n)/(sref*bref) cmst_d_diff(3, j, n) = cmst_d_diff(3, j, n) + sr*cr* - + temp_diff2 - temp_diff1 = cmst_d(3, j, n)*temp_diff2 - temp_diff3 = -(cmst_d(3, j, n)*sr*cr*temp_diff2/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff3 - bref_diff = bref_diff + sref*temp_diff3 + + temp_diff3 + temp_diff1 = cmst_d(3, j, n)*temp_diff3 + temp_diff2 = -(cmst_d(3, j, n)*sr*cr*temp_diff3/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff2 + bref_diff = bref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff2 = cms_d_diff(2, is, n)/(sref*cref) + temp_diff3 = cms_d_diff(2, is, n)/(sref*cref) cmst_d_diff(2, j, n) = cmst_d_diff(2, j, n) + sr*cr* - + temp_diff2 - temp_diff1 = cmst_d(2, j, n)*temp_diff2 - temp_diff3 = -(cmst_d(2, j, n)*sr*cr*temp_diff2/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff3 - cref_diff = cref_diff + sref*temp_diff3 + + temp_diff3 + temp_diff1 = cmst_d(2, j, n)*temp_diff3 + temp_diff2 = -(cmst_d(2, j, n)*sr*cr*temp_diff3/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff2 + cref_diff = cref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff2 = cms_d_diff(1, is, n)/(sref*bref) + temp_diff3 = cms_d_diff(1, is, n)/(sref*bref) cmst_d_diff(1, j, n) = cmst_d_diff(1, j, n) + sr*cr* - + temp_diff2 - temp_diff1 = cmst_d(1, j, n)*temp_diff2 - temp_diff3 = -(cmst_d(1, j, n)*sr*cr*temp_diff2/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff3 - bref_diff = bref_diff + sref*temp_diff3 + + temp_diff3 + temp_diff1 = cmst_d(1, j, n)*temp_diff3 + temp_diff2 = -(cmst_d(1, j, n)*sr*cr*temp_diff3/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff2 + bref_diff = bref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 DO l=3,1,-1 cfst_d_diff(l, j, n) = cfst_d_diff(l, j, n) + sr* + cfs_d_diff(l, is, n)/sref - temp_diff2 = cfst_d(l, j, n)*cfs_d_diff(l, is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cfst_d(l, j, n)*cfs_d_diff(l, is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref ENDDO clst_d_diff(j, n) = clst_d_diff(j, n) + sr*cls_d_diff(is, n) + /sref - temp_diff2 = clst_d(j, n)*cls_d_diff(is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = clst_d(j, n)*cls_d_diff(is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref cyst_d_diff(j, n) = cyst_d_diff(j, n) + sr*cys_d_diff(is, n) + /sref - temp_diff2 = cyst_d(j, n)*cys_d_diff(is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cyst_d(j, n)*cys_d_diff(is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref cdst_d_diff(j, n) = cdst_d_diff(j, n) + sr*cds_d_diff(is, n) + /sref - temp_diff2 = cdst_d(j, n)*cds_d_diff(is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cdst_d(j, n)*cds_d_diff(is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref ENDDO DO n=numax,1,-1 - temp_diff2 = cms_u_diff(3, is, n)/(sref*bref) + temp_diff3 = cms_u_diff(3, is, n)/(sref*bref) cmst_u_diff(3, j, n) = cmst_u_diff(3, j, n) + sr*cr* - + temp_diff2 - temp_diff1 = cmst_u(3, j, n)*temp_diff2 - temp_diff3 = -(cmst_u(3, j, n)*sr*cr*temp_diff2/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff3 - bref_diff = bref_diff + sref*temp_diff3 + + temp_diff3 + temp_diff1 = cmst_u(3, j, n)*temp_diff3 + temp_diff2 = -(cmst_u(3, j, n)*sr*cr*temp_diff3/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff2 + bref_diff = bref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff2 = cms_u_diff(2, is, n)/(sref*cref) + temp_diff3 = cms_u_diff(2, is, n)/(sref*cref) cmst_u_diff(2, j, n) = cmst_u_diff(2, j, n) + sr*cr* - + temp_diff2 - temp_diff1 = cmst_u(2, j, n)*temp_diff2 - temp_diff3 = -(cmst_u(2, j, n)*sr*cr*temp_diff2/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff3 - cref_diff = cref_diff + sref*temp_diff3 + + temp_diff3 + temp_diff1 = cmst_u(2, j, n)*temp_diff3 + temp_diff2 = -(cmst_u(2, j, n)*sr*cr*temp_diff3/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff2 + cref_diff = cref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff2 = cms_u_diff(1, is, n)/(sref*bref) + temp_diff3 = cms_u_diff(1, is, n)/(sref*bref) cmst_u_diff(1, j, n) = cmst_u_diff(1, j, n) + sr*cr* - + temp_diff2 - temp_diff1 = cmst_u(1, j, n)*temp_diff2 - temp_diff3 = -(cmst_u(1, j, n)*sr*cr*temp_diff2/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff3 - bref_diff = bref_diff + sref*temp_diff3 + + temp_diff3 + temp_diff1 = cmst_u(1, j, n)*temp_diff3 + temp_diff2 = -(cmst_u(1, j, n)*sr*cr*temp_diff3/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff2 + bref_diff = bref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 DO l=3,1,-1 cfst_u_diff(l, j, n) = cfst_u_diff(l, j, n) + sr* + cfs_u_diff(l, is, n)/sref - temp_diff2 = cfst_u(l, j, n)*cfs_u_diff(l, is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cfst_u(l, j, n)*cfs_u_diff(l, is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref ENDDO clst_u_diff(j, n) = clst_u_diff(j, n) + sr*cls_u_diff(is, n) + /sref - temp_diff2 = clst_u(j, n)*cls_u_diff(is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = clst_u(j, n)*cls_u_diff(is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref cyst_u_diff(j, n) = cyst_u_diff(j, n) + sr*cys_u_diff(is, n) + /sref - temp_diff2 = cyst_u(j, n)*cys_u_diff(is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cyst_u(j, n)*cys_u_diff(is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref cdst_u_diff(j, n) = cdst_u_diff(j, n) + sr*cds_u_diff(is, n) + /sref - temp_diff2 = cdst_u(j, n)*cds_u_diff(is, n)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cdst_u(j, n)*cds_u_diff(is, n)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref ENDDO clst_a_diff(j) = clst_a_diff(j) + sr*cls_a_diff(is)/sref - temp_diff2 = clst_a(j)*cls_a_diff(is)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = clst_a(j)*cls_a_diff(is)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref cdst_a_diff(j) = cdst_a_diff(j) + sr*cds_a_diff(is)/sref - temp_diff2 = cdst_a(j)*cds_a_diff(is)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff3 = cdst_a(j)*cds_a_diff(is)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref cdv_lstrp_diff(j) = cdv_lstrp_diff(j) + sr*cdvsurf_diff(is)/ + sref - temp_diff2 = cdv_lstrp(j)*cdvsurf_diff(is)/sref - sr_diff = sr_diff + temp_diff2 - sref_diff = sref_diff - sr*temp_diff2/sref - temp_diff2 = cmsurf_diff(3, is)/(sref*bref) - cmstrp_diff(3, j) = cmstrp_diff(3, j) + sr*cr*temp_diff2 - temp_diff1 = cmstrp(3, j)*temp_diff2 - temp_diff3 = -(cmstrp(3, j)*sr*cr*temp_diff2/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff3 - bref_diff = bref_diff + sref*temp_diff3 + temp_diff3 = cdv_lstrp(j)*cdvsurf_diff(is)/sref + sr_diff = sr_diff + temp_diff3 + sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff3 = cmsurf_diff(3, is)/(sref*bref) + cmstrp_diff(3, j) = cmstrp_diff(3, j) + sr*cr*temp_diff3 + temp_diff1 = cmstrp(3, j)*temp_diff3 + temp_diff2 = -(cmstrp(3, j)*sr*cr*temp_diff3/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff2 + bref_diff = bref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff2 = cmsurf_diff(2, is)/(sref*cref) - cmstrp_diff(2, j) = cmstrp_diff(2, j) + sr*cr*temp_diff2 - temp_diff1 = cmstrp(2, j)*temp_diff2 - temp_diff3 = -(cmstrp(2, j)*sr*cr*temp_diff2/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff3 - cref_diff = cref_diff + sref*temp_diff3 + temp_diff3 = cmsurf_diff(2, is)/(sref*cref) + cmstrp_diff(2, j) = cmstrp_diff(2, j) + sr*cr*temp_diff3 + temp_diff1 = cmstrp(2, j)*temp_diff3 + temp_diff2 = -(cmstrp(2, j)*sr*cr*temp_diff3/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff2 + cref_diff = cref_diff + sref*temp_diff2 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 temp_diff2 = cmsurf_diff(1, is)/(sref*bref) @@ -1950,9 +1953,6 @@ SUBROUTINE SFFORC_B() chord_diff(j) = chord_diff(j) + cr_diff + wstrip(j)*sr_diff wstrip_diff(j) = wstrip_diff(j) + chord(j)*sr_diff ENDDO - CALL POPREAL8(cr) - CALL POPREAL8(sr) - CALL POPINTEGER4(j) DO n=ncontrol,1,-1 DO l=3,1,-1 cms_d_diff(l, is, n) = 0.D0 @@ -1978,7 +1978,6 @@ SUBROUTINE SFFORC_B() cmsurf_diff(l, is) = 0.D0 cfsurf_diff(l, is) = 0.D0 ENDDO - CALL POPINTEGER4(l) clsurf_diff(is) = 0.D0 cysurf_diff(is) = 0.D0 cdsurf_diff(is) = 0.D0 @@ -2591,20 +2590,19 @@ SUBROUTINE SFFORC_B() IF (.NOT.ltrforce) THEN CALL PUSHCONTROL1B(0) ELSE - CALL PUSHINTEGER4(i) CALL PUSHREAL8ARRAY(f, 3) CALL PUSHREAL8ARRAY(g, 3) CALL PUSHREAL8ARRAY(wrot_u, 3) CALL PUSHREAL8ARRAY(fgam_u, 3*6) CALL PUSHREAL8ARRAY(veff_u, 3*6) CALL PUSHREAL8ARRAY(r, 3) + CALL PUSHREAL8ARRAY(vrot, 3) + CALL PUSHREAL8ARRAY(vrot_u, 3) CALL PUSHREAL8ARRAY(veff, 3) CALL PUSHREAL8ARRAY(fgam, 3) CALL PUSHREAL8ARRAY(f_u, 3*6) CALL PUSHREAL8ARRAY(rrot, 3) CALL PUSHREAL8ARRAY(fgam_d, 3*ndmax) - CALL PUSHREAL8ARRAY(vrot, 3) - CALL PUSHREAL8ARRAY(vrot_u, 3) C$FWD-OF II-LOOP C C----- Sum forces on trailing legs using velocity = (freestream + rotation) @@ -2839,36 +2837,24 @@ SUBROUTINE SFFORC_B() C R(2) = RC4(2) - RC4(2) C R(3) = RC4(3) - RC4(3) C--- Get rotational velocity at strip 1/4 chord reference point - CALL PUSHREAL8(rrot(1)) rrot(1) = rc4(1) - xyzref(1) - CALL PUSHREAL8(rrot(2)) rrot(2) = rc4(2) - xyzref(2) - CALL PUSHREAL8(rrot(3)) rrot(3) = rc4(3) - xyzref(3) C--- Onset velocity at strip c/4 = freestream + rotation CALL CROSS(rrot, wrot, vrot) - CALL PUSHREAL8(veff(1)) veff(1) = vinf(1) + vrot(1) - CALL PUSHREAL8(veff(2)) veff(2) = vinf(2) + vrot(2) - CALL PUSHREAL8(veff(3)) veff(3) = vinf(3) + vrot(3) veffmag = SQRT(veff(1)**2 + veff(2)**2 + veff(3)**2) C C------- set sensitivities to freestream,rotation components DO k=1,3 - CALL PUSHREAL8(veff_u(1, k)) veff_u(1, k) = 0. - CALL PUSHREAL8(veff_u(2, k)) veff_u(2, k) = 0. - CALL PUSHREAL8(veff_u(3, k)) veff_u(3, k) = 0. ENDDO - CALL PUSHREAL8(veff_u(1, 1)) veff_u(1, 1) = 1.0 - CALL PUSHREAL8(veff_u(2, 2)) veff_u(2, 2) = 1.0 - CALL PUSHREAL8(veff_u(3, 3)) veff_u(3, 3) = 1.0 DO k=4,6 CALL PUSHREAL8(wrot_u(1)) @@ -2880,11 +2866,8 @@ SUBROUTINE SFFORC_B() CALL PUSHREAL8(wrot_u(k-3)) wrot_u(k-3) = 1.0 CALL CROSS(rrot, wrot_u, vrot_u) - CALL PUSHREAL8(veff_u(1, k)) veff_u(1, k) = vrot_u(1) - CALL PUSHREAL8(veff_u(2, k)) veff_u(2, k) = vrot_u(2) - CALL PUSHREAL8(veff_u(3, k)) veff_u(3, k) = vrot_u(3) ENDDO DO n=1,numax @@ -2991,11 +2974,8 @@ SUBROUTINE SFFORC_B() END IF C C------ vector from chord c/4 reference point to case reference point XYZREF - CALL PUSHREAL8(r(1)) r(1) = rc4(1) - xyzref(1) - CALL PUSHREAL8(r(2)) r(2) = rc4(2) - xyzref(2) - CALL PUSHREAL8(r(3)) r(3) = rc4(3) - xyzref(3) C... Strip moments in body axes about the case moment reference point XYZREF C normalized by strip area and chord @@ -3133,15 +3113,12 @@ SUBROUTINE SFFORC_B() cfy_diff = cfy_diff - r(3)*temp_diff r_diff(3) = r_diff(3) - cfy*temp_diff cr_diff = cr_diff - (cfz*r(2)-cfy*r(3))*temp_diff/cr - CALL POPREAL8(r(3)) rc4_diff(3) = rc4_diff(3) + r_diff(3) xyzref_diff(3) = xyzref_diff(3) - r_diff(3) r_diff(3) = 0.D0 - CALL POPREAL8(r(2)) rc4_diff(2) = rc4_diff(2) + r_diff(2) xyzref_diff(2) = xyzref_diff(2) - r_diff(2) r_diff(2) = 0.D0 - CALL POPREAL8(r(1)) rc4_diff(1) = rc4_diff(1) + r_diff(1) xyzref_diff(1) = xyzref_diff(1) - r_diff(1) r_diff(1) = 0.D0 @@ -3352,13 +3329,10 @@ SUBROUTINE SFFORC_B() + veff_u(2, n)+veff(3)*veff_u(3, n))*temp_diff/veffmag ENDDO DO k=6,4,-1 - CALL POPREAL8(veff_u(3, k)) vrot_u_diff(3) = vrot_u_diff(3) + veff_u_diff(3, k) veff_u_diff(3, k) = 0.D0 - CALL POPREAL8(veff_u(2, k)) vrot_u_diff(2) = vrot_u_diff(2) + veff_u_diff(2, k) veff_u_diff(2, k) = 0.D0 - CALL POPREAL8(veff_u(1, k)) vrot_u_diff(1) = vrot_u_diff(1) + veff_u_diff(1, k) veff_u_diff(1, k) = 0.D0 DO ii1=1,3 @@ -3371,18 +3345,12 @@ SUBROUTINE SFFORC_B() CALL POPREAL8(wrot_u(2)) CALL POPREAL8(wrot_u(1)) ENDDO - CALL POPREAL8(veff_u(3, 3)) veff_u_diff(3, 3) = 0.D0 - CALL POPREAL8(veff_u(2, 2)) veff_u_diff(2, 2) = 0.D0 - CALL POPREAL8(veff_u(1, 1)) veff_u_diff(1, 1) = 0.D0 DO k=3,1,-1 - CALL POPREAL8(veff_u(3, k)) veff_u_diff(3, k) = 0.D0 - CALL POPREAL8(veff_u(2, k)) veff_u_diff(2, k) = 0.D0 - CALL POPREAL8(veff_u(1, k)) veff_u_diff(1, k) = 0.D0 ENDDO IF (veff(1)**2 + veff(2)**2 + veff(3)**2 .EQ. 0.D0) THEN @@ -3394,29 +3362,23 @@ SUBROUTINE SFFORC_B() veff_diff(1) = veff_diff(1) + 2*veff(1)*temp_diff veff_diff(2) = veff_diff(2) + 2*veff(2)*temp_diff veff_diff(3) = veff_diff(3) + 2*veff(3)*temp_diff - CALL POPREAL8(veff(3)) vinf_diff(3) = vinf_diff(3) + veff_diff(3) vrot_diff(3) = vrot_diff(3) + veff_diff(3) veff_diff(3) = 0.D0 - CALL POPREAL8(veff(2)) vinf_diff(2) = vinf_diff(2) + veff_diff(2) vrot_diff(2) = vrot_diff(2) + veff_diff(2) veff_diff(2) = 0.D0 - CALL POPREAL8(veff(1)) vinf_diff(1) = vinf_diff(1) + veff_diff(1) vrot_diff(1) = vrot_diff(1) + veff_diff(1) veff_diff(1) = 0.D0 CALL CROSS_B(rrot, rrot_diff, wrot, wrot_diff, vrot, vrot_diff + ) - CALL POPREAL8(rrot(3)) rc4_diff(3) = rc4_diff(3) + rrot_diff(3) xyzref_diff(3) = xyzref_diff(3) - rrot_diff(3) rrot_diff(3) = 0.D0 - CALL POPREAL8(rrot(2)) rc4_diff(2) = rc4_diff(2) + rrot_diff(2) xyzref_diff(2) = xyzref_diff(2) - rrot_diff(2) rrot_diff(2) = 0.D0 - CALL POPREAL8(rrot(1)) rc4_diff(1) = rc4_diff(1) + rrot_diff(1) xyzref_diff(1) = xyzref_diff(1) - rrot_diff(1) rrot_diff(1) = 0.D0 @@ -3431,22 +3393,19 @@ SUBROUTINE SFFORC_B() xte1_diff = 0.D0 xte2_diff = 0.D0 sr_diff = 0.D0 - CALL POPREAL8ARRAY(vrot_u, 3) - CALL POPREAL8ARRAY(vrot, 3) - CALL ADSTACK_STARTREPEAT() CALL POPREAL8ARRAY(fgam_d, 3*ndmax) CALL POPREAL8ARRAY(rrot, 3) CALL POPREAL8ARRAY(f_u, 3*6) CALL POPREAL8ARRAY(fgam, 3) CALL POPREAL8ARRAY(veff, 3) + CALL POPREAL8ARRAY(vrot_u, 3) + CALL POPREAL8ARRAY(vrot, 3) CALL POPREAL8ARRAY(r, 3) CALL POPREAL8ARRAY(veff_u, 3*6) CALL POPREAL8ARRAY(fgam_u, 3*6) CALL POPREAL8ARRAY(wrot_u, 3) CALL POPREAL8ARRAY(g, 3) CALL POPREAL8ARRAY(f, 3) - CALL ADSTACK_RESETREPEAT() - CALL ADSTACK_ENDREPEAT() C$BWD-OF II-LOOP DO ii=1,nvc_strp i = i1 + (ii-1) @@ -3527,7 +3486,6 @@ SUBROUTINE SFFORC_B() veff_u(k, k) = 1.0 ENDDO CALL PUSHREAL8ARRAY(wrot_u, 3) - CALL PUSHREAL8ARRAY(veff_u, 3*6) C$FWD-OF II-LOOP DO k=4,6 wrot_u(1) = 0. @@ -3736,11 +3694,7 @@ SUBROUTINE SFFORC_B() ENDDO CALL POPREAL8ARRAY(f, 3) CALL CROSS_B(veff, veff_diff, g, g_diff, f, f_diff) - CALL POPREAL8ARRAY(veff_u, 3*6) - CALL ADSTACK_STARTREPEAT() CALL POPREAL8ARRAY(wrot_u, 3) - CALL ADSTACK_RESETREPEAT() - CALL ADSTACK_ENDREPEAT() C$BWD-OF II-LOOP DO k=4,6 wrot_u(1) = 0. @@ -3759,7 +3713,6 @@ SUBROUTINE SFFORC_B() CALL CROSS_B(rrot, rrot_diff, wrot_u, wrot_u_diff, + vrot_u, vrot_u_diff) ENDDO - CALL POPREAL8ARRAY(wrot_u, 3) CALL POPREAL8ARRAY(veff_u, 3*6) C$BWD-OF II-LOOP DO k=1,3 @@ -3852,18 +3805,6 @@ SUBROUTINE SFFORC_B() END IF ENDDO ENDDO - CALL POPREAL8ARRAY(fgam_d, 3*ndmax) - CALL POPREAL8ARRAY(rrot, 3) - CALL POPREAL8ARRAY(f_u, 3*6) - CALL POPREAL8ARRAY(fgam, 3) - CALL POPREAL8ARRAY(veff, 3) - CALL POPREAL8ARRAY(r, 3) - CALL POPREAL8ARRAY(veff_u, 3*6) - CALL POPREAL8ARRAY(fgam_u, 3*6) - CALL POPREAL8ARRAY(wrot_u, 3) - CALL POPREAL8ARRAY(g, 3) - CALL POPREAL8ARRAY(f, 3) - CALL POPINTEGER4(i) END IF CALL POPREAL8ARRAY(veff_d, 3*ndmax) CALL POPREAL8ARRAY(fgam_d, 3*ndmax) @@ -3999,8 +3940,6 @@ SUBROUTINE SFFORC_B() fgam_d(2, n) = 2.0*gam_d(i, n)*f(2) + 2.0*gam(i)*f_d(2, n) fgam_d(3, n) = 2.0*gam_d(i, n)*f(3) + 2.0*gam(i)*f_d(3, n) ENDDO - CALL PUSHINTEGER4(n) - CALL PUSHINTEGER4(n) C C-------- vortex contribution to strip forces dcfx = fgam(1)/sr @@ -4012,9 +3951,6 @@ SUBROUTINE SFFORC_B() C-------- moments referred to strip c/4 pt., normalized by strip chord and area C C-------- accumulate strip spanloading = c*CN - CALL PUSHINTEGER4(n) - CALL PUSHINTEGER4(l) - CALL POPINTEGER4(l) C$BWD-OF II-LOOP DO n=1,ncontrol dcfx_d = fgam_d(1, n)/sr @@ -4077,7 +4013,6 @@ SUBROUTINE SFFORC_B() fgam_u_diff(2, n) = fgam_u_diff(2, n) + dcfy_u_diff/sr fgam_u_diff(1, n) = fgam_u_diff(1, n) + dcfx_u_diff/sr ENDDO - CALL POPINTEGER4(n) temp_diff = cmz_diff/cr dcfy_diff = r(1)*temp_diff r_diff(1) = r_diff(1) + dcfy*temp_diff @@ -4101,8 +4036,6 @@ SUBROUTINE SFFORC_B() + dcfy_diff/sr**2 - fgam(1)*dcfx_diff/sr**2 fgam_diff(2) = fgam_diff(2) + dcfy_diff/sr fgam_diff(1) = fgam_diff(1) + dcfx_diff/sr - CALL POPINTEGER4(n) - CALL POPINTEGER4(n) C$BWD-OF II-LOOP DO n=1,ncontrol gam_d_diff(i, n) = gam_d_diff(i, n) + f(3)*2.0*fgam_d_diff(3 @@ -4413,12 +4346,6 @@ SUBROUTINE SFFORC_B() wstrip_diff(j) = wstrip_diff(j) + chord(j)*sr_diff ENDDO alfa_diff = alfa_diff + COS(alfa)*sina_diff - SIN(alfa)*cosa_diff -C write(6,*) 'Strip J ',J -C write(6,*) 'UDRAG ',UDRAG -C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG -C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) -C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) -C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) 3 FORMAT(a,6(2x,f8.5)) END @@ -4481,10 +4408,10 @@ SUBROUTINE BDFORC_B() REAL dir EXTERNAL GETSA REAL temp_diff - REAL(kind=8) temp_diff0 + REAL(kind=avl_real) temp_diff0 INTEGER ii1 REAL(kind=avl_real) temp_diff1 - INTEGER branch + INTEGER*4 branch INTEGER ii2 C C @@ -4714,54 +4641,54 @@ SUBROUTINE BDFORC_B() cdbdy_diff(ib) = cdbdy_diff(ib) + cdtot_diff DO ilseg=nl(ib)-1,1,-1 DO iu=6,1,-1 - temp_diff0 = 2.0*cmbdy_u_diff(3, iu)/(sref*bref) - mb_u_diff(3, iu) = mb_u_diff(3, iu) + temp_diff0 - temp_diff1 = -(mb_u(3, iu)*temp_diff0/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff1 - bref_diff = bref_diff + sref*temp_diff1 - temp_diff0 = 2.0*cmbdy_u_diff(2, iu)/(sref*cref) - mb_u_diff(2, iu) = mb_u_diff(2, iu) + temp_diff0 - temp_diff1 = -(mb_u(2, iu)*temp_diff0/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff1 - cref_diff = cref_diff + sref*temp_diff1 - temp_diff0 = 2.0*cmbdy_u_diff(1, iu)/(sref*bref) - mb_u_diff(1, iu) = mb_u_diff(1, iu) + temp_diff0 - temp_diff1 = -(mb_u(1, iu)*temp_diff0/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff1 - bref_diff = bref_diff + sref*temp_diff1 + temp_diff1 = 2.0*cmbdy_u_diff(3, iu)/(sref*bref) + mb_u_diff(3, iu) = mb_u_diff(3, iu) + temp_diff1 + temp_diff0 = -(mb_u(3, iu)*temp_diff1/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff0 + bref_diff = bref_diff + sref*temp_diff0 + temp_diff1 = 2.0*cmbdy_u_diff(2, iu)/(sref*cref) + mb_u_diff(2, iu) = mb_u_diff(2, iu) + temp_diff1 + temp_diff0 = -(mb_u(2, iu)*temp_diff1/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff0 + cref_diff = cref_diff + sref*temp_diff0 + temp_diff1 = 2.0*cmbdy_u_diff(1, iu)/(sref*bref) + mb_u_diff(1, iu) = mb_u_diff(1, iu) + temp_diff1 + temp_diff0 = -(mb_u(1, iu)*temp_diff1/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff0 + bref_diff = bref_diff + sref*temp_diff0 DO l=3,1,-1 - temp_diff0 = 2.0*cfbdy_u_diff(l, iu)/sref - fb_u_diff(l, iu) = fb_u_diff(l, iu) + temp_diff0 - sref_diff = sref_diff - fb_u(l, iu)*temp_diff0/sref + temp_diff1 = 2.0*cfbdy_u_diff(l, iu)/sref + fb_u_diff(l, iu) = fb_u_diff(l, iu) + temp_diff1 + sref_diff = sref_diff - fb_u(l, iu)*temp_diff1/sref ENDDO - temp_diff0 = 2.0*clbdy_u_diff(iu)/sref - fb_u_diff(3, iu) = fb_u_diff(3, iu) + cosa*temp_diff0 - cosa_diff = cosa_diff + fb_u(3, iu)*temp_diff0 - fb_u_diff(1, iu) = fb_u_diff(1, iu) - sina*temp_diff0 - sina_diff = sina_diff - fb_u(1, iu)*temp_diff0 + temp_diff1 = 2.0*clbdy_u_diff(iu)/sref + fb_u_diff(3, iu) = fb_u_diff(3, iu) + cosa*temp_diff1 + cosa_diff = cosa_diff + fb_u(3, iu)*temp_diff1 + fb_u_diff(1, iu) = fb_u_diff(1, iu) - sina*temp_diff1 + sina_diff = sina_diff - fb_u(1, iu)*temp_diff1 sref_diff = sref_diff - (fb_u(3, iu)*cosa-fb_u(1, iu)*sina)* - + temp_diff0/sref - temp_diff0 = 2.0*cybdy_u_diff(iu)/sref - fb_u_diff(2, iu) = fb_u_diff(2, iu) + temp_diff0 - sref_diff = sref_diff - fb_u(2, iu)*temp_diff0/sref - temp_diff0 = 2.0*cdbdy_u_diff(iu)/sref - fb_u_diff(1, iu) = fb_u_diff(1, iu) + cosa*temp_diff0 - cosa_diff = cosa_diff + fb_u(1, iu)*temp_diff0 - fb_u_diff(3, iu) = fb_u_diff(3, iu) + sina*temp_diff0 - sina_diff = sina_diff + fb_u(3, iu)*temp_diff0 + + temp_diff1/sref + temp_diff1 = 2.0*cybdy_u_diff(iu)/sref + fb_u_diff(2, iu) = fb_u_diff(2, iu) + temp_diff1 + sref_diff = sref_diff - fb_u(2, iu)*temp_diff1/sref + temp_diff1 = 2.0*cdbdy_u_diff(iu)/sref + fb_u_diff(1, iu) = fb_u_diff(1, iu) + cosa*temp_diff1 + cosa_diff = cosa_diff + fb_u(1, iu)*temp_diff1 + fb_u_diff(3, iu) = fb_u_diff(3, iu) + sina*temp_diff1 + sina_diff = sina_diff + fb_u(3, iu)*temp_diff1 sref_diff = sref_diff - (fb_u(1, iu)*cosa+fb_u(3, iu)*sina)* - + temp_diff0/sref + + temp_diff1/sref ENDDO - temp_diff0 = 2.0*cmbdy_diff(3, ib)/(sref*bref) - mb_diff(3) = mb_diff(3) + temp_diff0 - temp_diff1 = -(mb(3)*temp_diff0/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff1 - bref_diff = bref_diff + sref*temp_diff1 - temp_diff0 = 2.0*cmbdy_diff(2, ib)/(sref*cref) - mb_diff(2) = mb_diff(2) + temp_diff0 - temp_diff1 = -(mb(2)*temp_diff0/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff1 - cref_diff = cref_diff + sref*temp_diff1 + temp_diff1 = 2.0*cmbdy_diff(3, ib)/(sref*bref) + mb_diff(3) = mb_diff(3) + temp_diff1 + temp_diff0 = -(mb(3)*temp_diff1/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff0 + bref_diff = bref_diff + sref*temp_diff0 + temp_diff1 = 2.0*cmbdy_diff(2, ib)/(sref*cref) + mb_diff(2) = mb_diff(2) + temp_diff1 + temp_diff0 = -(mb(2)*temp_diff1/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff0 + cref_diff = cref_diff + sref*temp_diff0 temp_diff0 = 2.0*cmbdy_diff(1, ib)/(sref*bref) mb_diff(1) = mb_diff(1) + temp_diff0 temp_diff1 = -(mb(1)*temp_diff0/(sref*bref)) diff --git a/src/ad_src/reverse_ad_src/aic_b.f b/src/ad_src/reverse_ad_src/aic_b.f index 7518b9a..f3cc4bc 100644 --- a/src/ad_src/reverse_ad_src/aic_b.f +++ b/src/ad_src/reverse_ad_src/aic_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of vvor in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: chordv rc rv1 rv2 zsym betm @@ -94,20 +94,20 @@ SUBROUTINE VVOR_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL vs_diff REAL ws REAL ws_diff - REAL(kind=8) arg1 - REAL(kind=8) arg1_diff - REAL(kind=8) arg2 - REAL(kind=8) arg2_diff - REAL(kind=8) arg3 - REAL(kind=8) arg3_diff - REAL(kind=8) arg4 - REAL(kind=8) arg4_diff + REAL(kind=avl_real) arg1 + REAL(kind=avl_real) arg1_diff + REAL(kind=avl_real) arg2 + REAL(kind=avl_real) arg2_diff + REAL(kind=avl_real) arg3 + REAL(kind=avl_real) arg3_diff + REAL(kind=avl_real) arg4 + REAL(kind=avl_real) arg4_diff REAL(kind=avl_real) temp REAL(kind=avl_real) temp0 REAL(kind=avl_real) temp_diff REAL(kind=avl_real) temp_diff0 REAL(kind=avl_real) temp_diff1 - INTEGER branch + INTEGER*4 branch REAL vrcorec REAL vrcorew REAL zsym @@ -437,7 +437,7 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL temp_diff0 REAL temp_diff1 REAL temp_diff2 - INTEGER branch + INTEGER*4 branch INTEGER ad_to INTEGER ii1 INTEGER ii2 @@ -530,12 +530,12 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, CALL SRDVELC(rc(1, i), rc(2, i), rc(3, i), rl(1, l1), + arg1, arg2, rl(1, l2), arg3, arg4, betm, + rcore, vsrc, vdbl) - CALL PUSHCONTROL2B(2) + CALL PUSHCONTROL2B(0) ELSE CALL PUSHCONTROL2B(1) END IF ELSE - CALL PUSHCONTROL2B(0) + CALL PUSHCONTROL2B(2) END IF ENDDO ENDDO @@ -573,56 +573,10 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, rcore_diff = 0.D0 DO i=nc,1,-1 CALL POPCONTROL2B(branch) - IF (branch .NE. 0) THEN - IF (branch .NE. 1) THEN - DO iu=nu,1,-1 - DO k=3,1,-1 - temp_diff = fysym*fzsym*wc_u_diff(k, i, iu) - vsrc_diff(k) = vsrc_diff(k) + src_u(l, iu)*temp_diff - src_u_diff(l, iu) = src_u_diff(l, iu) + vsrc(k)* - + temp_diff - vdbl_diff(k, 1) = vdbl_diff(k, 1) + dbl_u(1, l, iu)* - + temp_diff - dbl_u_diff(1, l, iu) = dbl_u_diff(1, l, iu) + vdbl(k - + , 1)*temp_diff - vdbl_diff(k, 2) = vdbl_diff(k, 2) - dbl_u(2, l, iu)* - + temp_diff - dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) - vdbl(k - + , 2)*temp_diff - vdbl_diff(k, 3) = vdbl_diff(k, 3) - dbl_u(3, l, iu)* - + temp_diff - dbl_u_diff(3, l, iu) = dbl_u_diff(3, l, iu) - vdbl(k - + , 3)*temp_diff - ENDDO - ENDDO - arg1 = yoff - rl(2, l1) - arg2 = zoff - rl(3, l1) - arg3 = yoff - rl(2, l2) - arg4 = zoff - rl(3, l2) - CALL POPREAL8ARRAY(vsrc, 3) - CALL POPREAL8ARRAY(vdbl, 3**2) - arg1_diff = 0.D0 - arg2_diff = 0.D0 - arg3_diff = 0.D0 - arg4_diff = 0.D0 - CALL SRDVELC_B(rc(1, i), rc_diff(1, i), rc(2, i), - + rc_diff(2, i), rc(3, i), rc_diff(3, i), - + rl(1, l1), rl_diff(1, l1), arg1, - + arg1_diff, arg2, arg2_diff, rl(1, l2), - + rl_diff(1, l2), arg3, arg3_diff, arg4, - + arg4_diff, betm, betm_diff, rcore, - + rcore_diff, vsrc, vsrc_diff, vdbl, - + vdbl_diff) - zoff_diff = zoff_diff + arg4_diff + arg2_diff - rl_diff(3, l2) = rl_diff(3, l2) - arg4_diff - yoff_diff = yoff_diff + arg3_diff + arg1_diff - rl_diff(2, l2) = rl_diff(2, l2) - arg3_diff - rl_diff(3, l1) = rl_diff(3, l1) - arg2_diff - rl_diff(2, l1) = rl_diff(2, l1) - arg1_diff - END IF + IF (branch .EQ. 0) THEN DO iu=nu,1,-1 DO k=3,1,-1 - temp_diff = fzsym*wc_u_diff(k, i, iu) + temp_diff = fysym*fzsym*wc_u_diff(k, i, iu) vsrc_diff(k) = vsrc_diff(k) + src_u(l, iu)*temp_diff src_u_diff(l, iu) = src_u_diff(l, iu) + vsrc(k)* + temp_diff @@ -630,9 +584,9 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, + temp_diff dbl_u_diff(1, l, iu) = dbl_u_diff(1, l, iu) + vdbl(k, + 1)*temp_diff - vdbl_diff(k, 2) = vdbl_diff(k, 2) + dbl_u(2, l, iu)* + vdbl_diff(k, 2) = vdbl_diff(k, 2) - dbl_u(2, l, iu)* + temp_diff - dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) + vdbl(k, + dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) - vdbl(k, + 2)*temp_diff vdbl_diff(k, 3) = vdbl_diff(k, 3) - dbl_u(3, l, iu)* + temp_diff @@ -640,25 +594,69 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, + 3)*temp_diff ENDDO ENDDO - arg1 = zoff - rl(3, l1) - arg2 = zoff - rl(3, l2) + arg1 = yoff - rl(2, l1) + arg2 = zoff - rl(3, l1) + arg3 = yoff - rl(2, l2) + arg4 = zoff - rl(3, l2) CALL POPREAL8ARRAY(vsrc, 3) CALL POPREAL8ARRAY(vdbl, 3**2) arg1_diff = 0.D0 arg2_diff = 0.D0 + arg3_diff = 0.D0 + arg4_diff = 0.D0 CALL SRDVELC_B(rc(1, i), rc_diff(1, i), rc(2, i), rc_diff( + 2, i), rc(3, i), rc_diff(3, i), rl(1, l1), - + rl_diff(1, l1), rl(2, l1), rl_diff(2, l1), - + arg1, arg1_diff, rl(1, l2), rl_diff(1, l2) - + , rl(2, l2), rl_diff(2, l2), arg2, - + arg2_diff, betm, betm_diff, rcore, - + rcore_diff, vsrc, vsrc_diff, vdbl, - + vdbl_diff) - zoff_diff = zoff_diff + arg2_diff + arg1_diff - rl_diff(3, l2) = rl_diff(3, l2) - arg2_diff - rl_diff(3, l1) = rl_diff(3, l1) - arg1_diff + + rl_diff(1, l1), arg1, arg1_diff, arg2, + + arg2_diff, rl(1, l2), rl_diff(1, l2), arg3 + + , arg3_diff, arg4, arg4_diff, betm, + + betm_diff, rcore, rcore_diff, vsrc, + + vsrc_diff, vdbl, vdbl_diff) + zoff_diff = zoff_diff + arg4_diff + arg2_diff + rl_diff(3, l2) = rl_diff(3, l2) - arg4_diff + yoff_diff = yoff_diff + arg3_diff + arg1_diff + rl_diff(2, l2) = rl_diff(2, l2) - arg3_diff + rl_diff(3, l1) = rl_diff(3, l1) - arg2_diff + rl_diff(2, l1) = rl_diff(2, l1) - arg1_diff + ELSE IF (branch .NE. 1) THEN + GOTO 100 END IF - CALL POPCONTROL1B(branch) + DO iu=nu,1,-1 + DO k=3,1,-1 + temp_diff = fzsym*wc_u_diff(k, i, iu) + vsrc_diff(k) = vsrc_diff(k) + src_u(l, iu)*temp_diff + src_u_diff(l, iu) = src_u_diff(l, iu) + vsrc(k)* + + temp_diff + vdbl_diff(k, 1) = vdbl_diff(k, 1) + dbl_u(1, l, iu)* + + temp_diff + dbl_u_diff(1, l, iu) = dbl_u_diff(1, l, iu) + vdbl(k, 1) + + *temp_diff + vdbl_diff(k, 2) = vdbl_diff(k, 2) + dbl_u(2, l, iu)* + + temp_diff + dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) + vdbl(k, 2) + + *temp_diff + vdbl_diff(k, 3) = vdbl_diff(k, 3) - dbl_u(3, l, iu)* + + temp_diff + dbl_u_diff(3, l, iu) = dbl_u_diff(3, l, iu) - vdbl(k, 3) + + *temp_diff + ENDDO + ENDDO + arg1 = zoff - rl(3, l1) + arg2 = zoff - rl(3, l2) + CALL POPREAL8ARRAY(vsrc, 3) + CALL POPREAL8ARRAY(vdbl, 3**2) + arg1_diff = 0.D0 + arg2_diff = 0.D0 + CALL SRDVELC_B(rc(1, i), rc_diff(1, i), rc(2, i), rc_diff(2 + + , i), rc(3, i), rc_diff(3, i), rl(1, l1), + + rl_diff(1, l1), rl(2, l1), rl_diff(2, l1), + + arg1, arg1_diff, rl(1, l2), rl_diff(1, l2), + + rl(2, l2), rl_diff(2, l2), arg2, arg2_diff, + + betm, betm_diff, rcore, rcore_diff, vsrc, + + vsrc_diff, vdbl, vdbl_diff) + zoff_diff = zoff_diff + arg2_diff + arg1_diff + rl_diff(3, l2) = rl_diff(3, l2) - arg2_diff + rl_diff(3, l1) = rl_diff(3, l1) - arg1_diff + 100 CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN DO iu=nu,1,-1 DO k=3,1,-1 @@ -829,7 +827,7 @@ SUBROUTINE SRDSET_B(betm, betm_diff, xyzref, xyzref_diff, iysym, REAL DOT REAL temp_diff INTEGER ii1 - INTEGER branch + INTEGER*4 branch INTEGER ad_to INTEGER nbody REAL pi @@ -1198,7 +1196,7 @@ SUBROUTINE VORVELC_B(x, x_diff, y, y_diff, z, z_diff, lbound, x1, REAL temp_diff4 INTEGER ii1 REAL temp_diff5 - INTEGER branch + INTEGER*4 branch REAL y1 REAL y1_diff REAL y2 diff --git a/src/ad_src/reverse_ad_src/amake_b.f b/src/ad_src/reverse_ad_src/amake_b.f index baaab36..dbb85ae 100644 --- a/src/ad_src/reverse_ad_src/amake_b.f +++ b/src/ad_src/reverse_ad_src/amake_b.f @@ -1,26 +1,27 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of update_surfaces in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: rle chord rle1 chord1 rle2 C chord2 wstrip ess ensy ensz xsref ysref zsref C rv1 rv2 rv rc rs dxv chordv enc env enc_d C with respect to varying inputs: xyzscal xyztran addinc xyzles -C chords aincs xasec sasec claf rle chord rle1 chord1 -C rle2 chord2 wstrip ess ensy ensz xsref ysref zsref -C rv1 rv2 rv rc rs dxv chordv enc env enc_d +C chords aincs xasec sasec claf mshblk rle chord +C rle1 chord1 rle2 chord2 wstrip ess ensy ensz xsref +C ysref zsref rv1 rv2 rv rc rs dxv chordv enc env +C enc_d C RW status of diff variables: xyzscal:out xyztran:out addinc:out C xyzles:out chords:out aincs:out xasec:out sasec:out -C claf:out rle:in-out chord:in-out rle1:in-out chord1:in-out -C rle2:in-out chord2:in-out wstrip:in-out ess:in-out -C ensy:in-out ensz:in-out xsref:in-out ysref:in-out -C zsref:in-out rv1:in-out rv2:in-out rv:in-out rc:in-out -C rs:in-out dxv:in-out chordv:in-out enc:in-out -C env:in-out enc_d:in-out -C MAKESURF +C claf:out mshblk:out rle:in-out chord:in-out rle1:in-out +C chord1:in-out rle2:in-out chord2:in-out wstrip:in-out +C ess:in-out ensy:in-out ensz:in-out xsref:in-out +C ysref:in-out zsref:in-out rv1:in-out rv2:in-out +C rv:in-out rc:in-out rs:in-out dxv:in-out chordv:in-out +C enc:in-out env:in-out enc_d:in-out SUBROUTINE UPDATE_SURFACES_B() use avl_heap_inc use avl_heap_diff_inc +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER ii @@ -30,29 +31,59 @@ SUBROUTINE UPDATE_SURFACES_B() EXTERNAL AVLHEAP_INIT EXTERNAL AVLHEAP_DIFF_INIT INTEGER ii1 - INTEGER branch + INTEGER*4 branch INTEGER ii2 INTEGER ii3 nstrip = 0 nvor = 0 isurf = 1 + nsurfdupl = 0 + DO ii=1,nsurf + IF (ldupl(ii)) THEN + CALL PUSHCONTROL1B(1) + nsurfdupl = nsurfdupl + 1 + ELSE + CALL PUSHCONTROL1B(0) + END IF + ENDDO C the iterations of this loop are not independent because we count C up the size information as we make each surface DO ii=1,nsurf-nsurfdupl - IF (lverbose) WRITE(*, *) 'Updating surface ', isurf - CALL PUSHREAL8ARRAY(chord, nsmax) - CALL PUSHINTEGER4ARRAY(nvstrp, nsmax) - CALL PUSHINTEGER4ARRAY(ijfrst, nsmax) - CALL PUSHINTEGER4ARRAY(nvs, nfmax) - CALL PUSHINTEGER4ARRAY(nvc, nfmax) - CALL PUSHINTEGER4ARRAY(jfrst, nfmax) - CALL PUSHINTEGER4ARRAY(nj, nfmax) - CALL MAKESURF(isurf) + IF (lsurfmsh(isurf)) THEN + CALL PUSHREAL8ARRAY(dxv, nvmax) + CALL PUSHREAL8ARRAY(rc, 3*nvmax) + CALL PUSHREAL8ARRAY(rv, 3*nvmax) + CALL PUSHREAL8ARRAY(chord2, nsmax) + CALL PUSHREAL8ARRAY(rle2, 3*nsmax) + CALL PUSHREAL8ARRAY(chord1, nsmax) + CALL PUSHREAL8ARRAY(rle1, 3*nsmax) + CALL PUSHREAL8ARRAY(chord, nsmax) + CALL PUSHREAL8ARRAY(rle, 3*nsmax) + CALL PUSHINTEGER4ARRAY(nvstrp, nsmax) + CALL PUSHINTEGER4ARRAY(ijfrst, nsmax) + CALL PUSHINTEGER4ARRAY(nvs, nfmax) + CALL PUSHINTEGER4ARRAY(nvc, nfmax) + CALL PUSHINTEGER4ARRAY(jfrst, nfmax) + CALL PUSHINTEGER4ARRAY(nj, nfmax) + CALL MAKESURF_MESH(isurf) + CALL PUSHCONTROL1B(0) + ELSE + CALL PUSHREAL8ARRAY(chord, nsmax) + CALL PUSHINTEGER4ARRAY(nvstrp, nsmax) + CALL PUSHINTEGER4ARRAY(ijfrst, nsmax) + CALL PUSHINTEGER4ARRAY(nvs, nfmax) + CALL PUSHINTEGER4ARRAY(nvc, nfmax) + CALL PUSHINTEGER4ARRAY(jfrst, nfmax) + CALL PUSHINTEGER4ARRAY(nj, nfmax) + CALL MAKESURF(isurf) + CALL PUSHCONTROL1B(1) + END IF IF (ldupl(isurf)) THEN - IF (lverbose) WRITE(*, *) ' reduplicating ', isurf CALL PUSHREAL8ARRAY(vrefl, nsmax*ndmax) CALL PUSHINTEGER4ARRAY(nvstrp, nsmax) CALL PUSHINTEGER4ARRAY(ijfrst, nsmax) + CALL PUSHBOOLEANARRAY(lmeshflat, nfmax) + CALL PUSHBOOLEANARRAY(lsurfmsh, nfmax) CALL PUSHINTEGER4ARRAY(nvs, nfmax) CALL PUSHINTEGER4ARRAY(nvc, nfmax) CALL PUSHBOOLEANARRAY(lsurfspacing, nfmax) @@ -122,6 +153,11 @@ SUBROUTINE UPDATE_SURFACES_B() claf_diff(ii2, ii1) = 0.D0 ENDDO ENDDO + DO ii1=1,4*nvmax + DO ii2=1,3 + mshblk_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO DO ii=nsurf-nsurfdupl,1,-1 CALL POPINTEGER4(isurf) CALL POPCONTROL1B(branch) @@ -136,19 +172,44 @@ SUBROUTINE UPDATE_SURFACES_B() CALL POPBOOLEANARRAY(lsurfspacing, nfmax) CALL POPINTEGER4ARRAY(nvc, nfmax) CALL POPINTEGER4ARRAY(nvs, nfmax) + CALL POPBOOLEANARRAY(lsurfmsh, nfmax) + CALL POPBOOLEANARRAY(lmeshflat, nfmax) CALL POPINTEGER4ARRAY(ijfrst, nsmax) CALL POPINTEGER4ARRAY(nvstrp, nsmax) CALL POPREAL8ARRAY(vrefl, nsmax*ndmax) CALL SDUPL_B(isurf, ydupl(isurf), 'ydup') END IF - CALL POPINTEGER4ARRAY(nj, nfmax) - CALL POPINTEGER4ARRAY(jfrst, nfmax) - CALL POPINTEGER4ARRAY(nvc, nfmax) - CALL POPINTEGER4ARRAY(nvs, nfmax) - CALL POPINTEGER4ARRAY(ijfrst, nsmax) - CALL POPINTEGER4ARRAY(nvstrp, nsmax) - CALL POPREAL8ARRAY(chord, nsmax) - CALL MAKESURF_B(isurf) + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + CALL POPINTEGER4ARRAY(nj, nfmax) + CALL POPINTEGER4ARRAY(jfrst, nfmax) + CALL POPINTEGER4ARRAY(nvc, nfmax) + CALL POPINTEGER4ARRAY(nvs, nfmax) + CALL POPINTEGER4ARRAY(ijfrst, nsmax) + CALL POPINTEGER4ARRAY(nvstrp, nsmax) + CALL POPREAL8ARRAY(rle, 3*nsmax) + CALL POPREAL8ARRAY(chord, nsmax) + CALL POPREAL8ARRAY(rle1, 3*nsmax) + CALL POPREAL8ARRAY(chord1, nsmax) + CALL POPREAL8ARRAY(rle2, 3*nsmax) + CALL POPREAL8ARRAY(chord2, nsmax) + CALL POPREAL8ARRAY(rv, 3*nvmax) + CALL POPREAL8ARRAY(rc, 3*nvmax) + CALL POPREAL8ARRAY(dxv, nvmax) + CALL MAKESURF_MESH_B(isurf) + ELSE + CALL POPINTEGER4ARRAY(nj, nfmax) + CALL POPINTEGER4ARRAY(jfrst, nfmax) + CALL POPINTEGER4ARRAY(nvc, nfmax) + CALL POPINTEGER4ARRAY(nvs, nfmax) + CALL POPINTEGER4ARRAY(ijfrst, nsmax) + CALL POPINTEGER4ARRAY(nvstrp, nsmax) + CALL POPREAL8ARRAY(chord, nsmax) + CALL MAKESURF_B(isurf) + END IF + ENDDO + DO ii=nsurf,1,-1 + CALL POPCONTROL1B(branch) ENDDO END @@ -351,7 +412,7 @@ SUBROUTINE MAKESURF_B(isurf) INTEGER ad_to0 INTEGER ad_count INTEGER i - INTEGER branch + INTEGER*4 branch INTEGER ii3 INTEGER ii2 INTEGER ad_to1 @@ -397,10 +458,10 @@ SUBROUTINE MAKESURF_B(isurf) dy = xyzles(2, isec, isurf) - xyzles(2, isec-1, isurf) dz = xyzles(3, isec, isurf) - xyzles(3, isec-1, isurf) yzlen(isec) = yzlen(isec-1) + SQRT(dy*dy + dz*dz) - ENDDO - CALL PUSHINTEGER4(isec - 1) C we can not rely on the original condition becuase NVS(ISURF) is filled C and we may want to rebuild the surface later + ENDDO + CALL PUSHINTEGER4(isec - 1) C IF (nvs(isurf) .EQ. 0 .OR. (lsurfspacing(isurf) .EQV. .false.)) + THEN @@ -508,6 +569,8 @@ SUBROUTINE MAKESURF_B(isurf) ad_count0 = 1 C C----- fudge spacing array to make nodes match up exactly with interior sections +C Throws an error in the case where the same node is the closest node +C to two consecutive sections DO isec=2,nsec(isurf)-1 CALL PUSHINTEGER4(ipt1) ipt1 = iptloc(isec-1) @@ -767,7 +830,7 @@ SUBROUTINE MAKESURF_B(isurf) C C C - CALL PUSHCONTROL1B(1) + CALL PUSHCONTROL1B(0) ELSE C----------- control variable # N is active here CALL PUSHREAL8(gainda(n)) @@ -838,7 +901,7 @@ SUBROUTINE MAKESURF_B(isurf) vmod = SQRT(vsq) C C - CALL PUSHCONTROL1B(0) + CALL PUSHCONTROL1B(1) END IF ENDDO C--- If the min drag is zero flag the strip as no-viscous data @@ -1185,6 +1248,16 @@ SUBROUTINE MAKESURF_B(isurf) DO n=ncontrol,1,-1 CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN + vhinge_diff(3, idx_strip, n) = 0.D0 + vhinge_diff(2, idx_strip, n) = 0.D0 + vhinge_diff(1, idx_strip, n) = 0.D0 + CALL POPREAL8(xted(n)) + xted_diff(n) = 0.D0 + CALL POPREAL8(xled(n)) + xled_diff(n) = 0.D0 + CALL POPREAL8(gainda(n)) + gainda_diff(n) = 0.D0 + ELSE vhz_diff = vhinge_diff(3, idx_strip, n)/vmod vmod_diff = -(vhz*vhinge_diff(3, idx_strip, n)/vmod**2 + ) - vhy*vhinge_diff(2, idx_strip, n)/vmod**2 - vhx* @@ -1293,16 +1366,6 @@ SUBROUTINE MAKESURF_B(isurf) chordl_diff = chordl_diff + (1.0-fc)*temp_diff1 CALL POPREAL8(gainda(n)) gainda_diff(n) = 0.D0 - ELSE - vhinge_diff(3, idx_strip, n) = 0.D0 - vhinge_diff(2, idx_strip, n) = 0.D0 - vhinge_diff(1, idx_strip, n) = 0.D0 - CALL POPREAL8(xted(n)) - xted_diff(n) = 0.D0 - CALL POPREAL8(xled(n)) - xled_diff(n) = 0.D0 - CALL POPREAL8(gainda(n)) - gainda_diff(n) = 0.D0 END IF CALL POPINTEGER4(icr) CALL POPINTEGER4(icl) @@ -2159,141 +2222,1860 @@ SUBROUTINE MAKESURF_B(isurf) + ) END -C Differentiation of sdupl in reverse (adjoint) mode (with options i4 dr8 r8): -C gradient of useful results: rle chord rle1 chord1 rle2 -C chord2 wstrip ainc ainc_g rv1 rv2 rv rc dxv chordv -C slopev slopec dcontrol vhinge -C with respect to varying inputs: rle chord rle1 chord1 rle2 -C chord2 wstrip ainc ainc_g rv1 rv2 rv rc dxv chordv -C slopev slopec dcontrol vhinge -C - SUBROUTINE SDUPL_B(nn, ypt, msg) +C Differentiation of makesurf_mesh in reverse (adjoint) mode (with options i4 dr8 r8): +C gradient of useful results: xyzscal xyztran addinc aincs +C xasec sasec claf mshblk rv1msh rv2msh rvmsh rcmsh +C rle chord rle1 chord1 rle2 chord2 wstrip ainc +C ainc_g rv1 rv2 rv rc rs dxv chordv slopev slopec +C dcontrol vhinge +C with respect to varying inputs: xyzscal xyztran addinc aincs +C xasec sasec claf mshblk rv1msh rv2msh rvmsh rcmsh +C rle chord rle1 chord1 rle2 chord2 wstrip ainc +C ainc_g rv1 rv2 rv rc rs dxv chordv slopev slopec +C dcontrol vhinge +C + SUBROUTINE MAKESURF_MESH_B(isurf) INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' - CHARACTER*(*) msg - INTEGER idx_vor - INTEGER nni - INTEGER klen - INTRINSIC LEN - INTEGER k +C working variables (AVL original) + INTEGER isurf + INTEGER kcmax + INTEGER ksmax + PARAMETER (kcmax=50, ksmax=500) + REAL chsin, chcos, chsinl, chsinr, chcosl, chcosr, aincl, aincr, + + chordl, chordr, clafl, clafr, slopel, sloper, dxdx, zu_l, + + zl_l, zu_r, zl_r, zl, zr, sum, wtot, astrp + REAL chsin_diff, chcos_diff, chsinl_diff, chsinr_diff, chcosl_diff + + , chcosr_diff, aincl_diff, aincr_diff, chordl_diff, + + chordr_diff, clafl_diff, clafr_diff, slopel_diff, sloper_diff + REAL chsinl_g(ngmax), chcosl_g(ngmax), chsinr_g(ngmax), chcosr_g( + + ngmax), xled(ndmax), xted(ndmax), gainda(ndmax) + REAL chsinl_g_diff(ngmax), chcosl_g_diff(ngmax), chsinr_g_diff( + + ngmax), chcosr_g_diff(ngmax), xled_diff(ndmax), xted_diff( + + ndmax) +C working variables (OptVL additions) + INTEGER isconl(ndmax), isconr(ndmax) + REAL m1, m2, m3, f1, f2, fc, dc1, dc2, dc, a1, a2, a3, xptxind1, + + xptxind2 + REAL m2_diff, m3_diff, dc1_diff, dc2_diff, a1_diff, a2_diff, + + a3_diff + REAL mesh_surf(3, (nvc(isurf)+1)*(nvs(isurf)+1)) + REAL mesh_surf_diff(3, (nvc(isurf)+1)*(nvs(isurf)+1)) +C functions + INTEGER idx_vor, idx_strip, idx_sec, idx_dim, idx_coef, idx_x, + + idx_node, idx_nodel, idx_noder, idx_node_yp1, idx_node_nx + + , idx_node_nx_yp1, idx_y, nx, ny +C +C Get data from common block + INTEGER FLATIDX INTEGER isec - INTEGER idup - INTEGER iorg - REAL yoff - INTEGER idx_strip - INTEGER ivs - INTEGER jji - INTEGER jj - INTEGER n - INTEGER l - INTEGER ivc - INTEGER iii INTEGER ii - REAL rsgn - REAL(kind=avl_real) tmp - REAL(kind=avl_real) tmp0 - REAL(kind=avl_real) tmp1 - REAL(kind=avl_real) tmp_diff - REAL(kind=avl_real) tmp2 - REAL(kind=avl_real) tmp_diff0 - REAL(kind=avl_real) tmp3 - REAL(kind=avl_real) tmp_diff1 - REAL(kind=avl_real) tmp4 - REAL(kind=avl_real) tmp_diff2 - REAL(kind=avl_real) tmp5 - REAL(kind=avl_real) tmp_diff3 - REAL(kind=avl_real) tmp6 - REAL(kind=avl_real) tmp7 - REAL(kind=avl_real) tmp_diff4 - REAL(kind=avl_real) tmp8 - REAL(kind=avl_real) tmp_diff5 - REAL(kind=avl_real) tmp9 - REAL(kind=avl_real) tmp10 - REAL(kind=avl_real) tmp_diff6 - REAL(kind=avl_real) tmp11 - REAL(kind=avl_real) tmp_diff7 - REAL(kind=avl_real) tmp12 - REAL(kind=avl_real) tmp_diff8 - REAL(kind=avl_real) tmp13 - REAL(kind=avl_real) tmp14 - REAL(kind=avl_real) tmp15 - REAL(kind=avl_real) tmp16 - REAL(kind=avl_real) tmp17 - REAL(kind=avl_real) tmp_diff9 - REAL(kind=avl_real) tmp18 - REAL(kind=avl_real) tmp_diff10 - REAL(kind=avl_real) tmp19 - REAL(kind=avl_real) tmp_diff11 - REAL(kind=avl_real) tmp20 - REAL(kind=avl_real) tmp_diff12 - REAL(kind=avl_real) tmp21 - REAL(kind=avl_real) tmp_diff13 - REAL(kind=avl_real) tmp22 - REAL(kind=avl_real) tmp_diff14 - REAL(kind=avl_real) tmp23 - REAL(kind=avl_real) tmp_diff15 - REAL(kind=avl_real) tmp24 - REAL(kind=avl_real) tmp_diff16 - REAL(kind=avl_real) tmp25 - REAL(kind=avl_real) tmp_diff17 - REAL(kind=avl_real) tmp26 - REAL(kind=avl_real) tmp_diff18 - REAL(kind=avl_real) tmp27 - REAL(kind=avl_real) tmp_diff19 - INTEGER ad_count - INTEGER i - INTEGER branch + INTEGER ispan + INTEGER iptl + INTEGER iptr + INTRINSIC SQRT + INTRINSIC SIN + INTRINSIC COS + INTEGER n + INTEGER iscon + INTEGER isdes + INTRINSIC ATAN2 + REAL chsin_g + REAL chsin_g_diff + REAL chcos_g + REAL chcos_g_diff + INTEGER icl + INTEGER icr + REAL xhd + REAL xhd_diff + REAL vhx + REAL vhx_diff + REAL vhy + REAL vhy_diff + REAL vhz + REAL vhz_diff + REAL vsq + REAL vsq_diff + INTRINSIC ABS + REAL vmod + REAL vmod_diff + INTEGER nsl + INTEGER nsr + REAL clafc + REAL clafc_diff + REAL dx1 + REAL dx1_diff + REAL dx2 + REAL dx2_diff + REAL dx3 + REAL dx3_diff + REAL dsdx + REAL xpt + REAL xpt_diff + REAL fracle + REAL fracle_diff + REAL fracte + REAL fracte_diff + INTRINSIC MAX + INTRINSIC MIN + REAL zu + INTEGER jj + INTEGER j + REAL y1 + REAL y1_diff + REAL y2 + REAL y2_diff + REAL(kind=avl_real) abs0 + REAL(kind=avl_real) abs0_diff + REAL(kind=avl_real) abs1 + REAL(kind=avl_real) abs1_diff + REAL(kind=avl_real) arg1 + REAL(kind=avl_real) arg1_diff + REAL temp + REAL temp0 + REAL temp1 + REAL temp_diff + REAL temp_diff0 + REAL temp_diff1 + REAL(kind=avl_real) temp2 + REAL(kind=avl_real) temp_diff2 + REAL(kind=avl_real) temp3 + REAL(kind=avl_real) temp_diff3 + REAL(kind=avl_real) temp4 + REAL(kind=avl_real) temp_diff4 INTEGER ad_to INTEGER ad_to0 INTEGER ad_to1 - INTEGER ad_count0 - INTEGER i0 - INTEGER ii3 - INTEGER ii2 - INTEGER ii1 - INTEGER nn - REAL ypt + INTEGER*4 branch + INTEGER ad_to2 + INTEGER ad_to3 + INTEGER ad_to4 C -C - nni = nn + 1 - IF (nni .GT. nfmax) THEN - STOP - ELSE + nx = nvc(isurf) + 1 +C Check MFRST + ny = nvs(isurf) + 1 +C Get the mesh for this surface from the the common block C - klen = LEN(stitle(nn)) - ad_count = 1 - DO k=klen,1,-1 - IF (stitle(nn)(k:k) .NE. ' ') THEN - GOTO 100 - ELSE - ad_count = ad_count + 1 - END IF - ENDDO - CALL PUSHCONTROL1B(0) - CALL PUSHINTEGER4(ad_count) - CALL PUSHINTEGER4(ivs) - CALL PUSHCONTROL1B(0) - GOTO 110 - 100 CALL PUSHCONTROL1B(1) - CALL PUSHINTEGER4(ad_count) - CALL PUSHINTEGER4(ivs) - CALL PUSHCONTROL1B(0) C -C---- duplicate surface is assumed to be the same logical component surface +C Perform input checks from makesurf (section check removed) + mesh_surf = mshblk(:, mfrst(isurf):mfrst(isurf)+nx*ny-1) C -C---- same various logical flags -C IFRST(NNI) = NVOR + 1 C -C---- accumulate stuff for new image surface -C JFRST(NNI) = NSTRIP + 1 - 110 jfrst(nni) = jfrst(nni-1) + nj(nni-1) - nj(nni) = nj(nn) - nk(nni) = nk(nn) + IF (nvc(isurf) .GT. kcmax) nvc(isurf) = kcmax +C Set NK from input data (python layer will ensure this is consistent) C - nvc(nni) = nk(nni) - nvs(nni) = nj(nni) + IF (isurf .EQ. 1) THEN + jfrst(isurf) = 1 + ELSE + jfrst(isurf) = jfrst(isurf-1) + nj(isurf-1) + END IF +C We need to start counting strips now since it is a global count +C +C Bypass the entire spanwise node generation routine and go straight to store counters +C skips MAKESURF 94-234 +C Index of first strip in surface +C This is normally used to store the index of each section in AVL +C but since we use strips now each is effectively just a section +C We assign this variable accordingly so as not to break anything else + idx_strip = jfrst(isurf) +C Number of strips/sections in surface +C +C +C + DO idx_y=1,ny + DO idx_x=1,nx + DO idx_dim=1,3 + CALL PUSHINTEGER4(idx_node) + idx_node = FLATIDX(idx_x, idx_y, isurf) + CALL PUSHREAL8(mesh_surf(idx_dim, idx_node)) + mesh_surf(idx_dim, idx_node) = xyzscal(idx_dim, isurf)* + + mesh_surf(idx_dim, idx_node) + xyztran(idx_dim, isurf) + ENDDO + ENDDO + CALL PUSHINTEGER4(idx_x - 1) + ENDDO + CALL PUSHINTEGER4(idx_y - 1) C -C--- Note hinge axis is flipped to reverse the Y component of the hinge +C +C +C Check control and design vars +C + IF (ncontrol .GT. ndmax) THEN + STOP + ELSE IF (ndesign .GT. ngmax) THEN +C Instead of looping over sections just loop over all strips in the surface +C + STOP + ELSE +C +Cispan loop +C Set reference information for the strip +C This code was used in the original to loop over strips in a section. +C We will just reuse the variables here + DO ispan=1,ny-1 +C +C + CALL PUSHINTEGER4(idx_y) + idx_y = idx_strip - jfrst(isurf) + 1 + CALL PUSHINTEGER4(iptl) + iptl = idx_y + CALL PUSHINTEGER4(iptr) + iptr = idx_y + 1 +C We need to compute the chord and claf values at the left and right edge of the strip +C This code was used in the original to interpolate over sections. +C We will just reuse here to interpolate over a strip which is trivial but avoids pointless code rewrites. +C +C + CALL PUSHINTEGER4(idx_node) + idx_node = FLATIDX(1, iptl, isurf) + CALL PUSHINTEGER4(idx_node_nx) + idx_node_nx = FLATIDX(nx, iptl, isurf) + CALL PUSHREAL8(chordl) + chordl = SQRT((mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node + + ))**2 + (mesh_surf(3, idx_node_nx)-mesh_surf(3, idx_node))** + + 2) + CALL PUSHINTEGER4(idx_node) + idx_node = FLATIDX(1, iptr, isurf) + CALL PUSHINTEGER4(idx_node_nx) + idx_node_nx = FLATIDX(nx, iptr, isurf) + CALL PUSHREAL8(chordr) + chordr = SQRT((mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node + + ))**2 + (mesh_surf(3, idx_node_nx)-mesh_surf(3, idx_node))** + + 2) + clafl = claf(iptl, isurf) +C Linearly interpolate the incidence projections over the STRIP + clafr = claf(iptr, isurf) +C + aincl = aincs(iptl, isurf)*dtr + addinc(isurf)*dtr + aincr = aincs(iptr, isurf)*dtr + addinc(isurf)*dtr + chsinl = chordl*SIN(aincl) + chsinr = chordr*SIN(aincr) + chcosl = chordl*COS(aincl) +C We need to determine which controls belong to this section +C Bring over the routine for this from makesurf but do it for each strip now + chcosr = chordr*COS(aincr) +C + DO n=1,ncontrol + isconl(n) = 0 + isconr(n) = 0 + DO iscon=1,nscon(iptl, isurf) + IF (icontd(iscon, iptl, isurf) .EQ. n) THEN + CALL PUSHCONTROL1B(1) + isconl(n) = iscon + ELSE + CALL PUSHCONTROL1B(0) + END IF + ENDDO + CALL PUSHINTEGER4(iscon - 1) + DO iscon=1,nscon(iptr, isurf) + IF (icontd(iscon, iptr, isurf) .EQ. n) THEN + CALL PUSHCONTROL1B(1) + isconr(n) = iscon + ELSE + CALL PUSHCONTROL1B(0) + END IF + ENDDO + CALL PUSHINTEGER4(iscon - 1) + ENDDO +C + DO n=1,ndesign + chsinl_g(n) = 0. + chsinr_g(n) = 0. + chcosl_g(n) = 0. + chcosr_g(n) = 0. +C + DO isdes=1,nsdes(iptl, isurf) + IF (idestd(isdes, iptl, isurf) .EQ. n) THEN + chsinl_g(n) = chcosl*gaing(isdes, iptl, isurf)*dtr + chcosl_g(n) = -(chsinl*gaing(isdes, iptl, isurf)*dtr) + CALL PUSHCONTROL1B(1) + ELSE + CALL PUSHCONTROL1B(0) + END IF + ENDDO + CALL PUSHINTEGER4(isdes - 1) +C + DO isdes=1,nsdes(iptr, isurf) + IF (idestd(isdes, iptr, isurf) .EQ. n) THEN + chsinr_g(n) = chcosr*gaing(isdes, iptr, isurf)*dtr + chcosr_g(n) = -(chsinr*gaing(isdes, iptr, isurf)*dtr) + CALL PUSHCONTROL1B(1) + ELSE + CALL PUSHCONTROL1B(0) + END IF + ENDDO + CALL PUSHINTEGER4(isdes - 1) + ENDDO +C +C +C + CALL PUSHINTEGER4(idx_node) + idx_node = FLATIDX(1, idx_y, isurf) + CALL PUSHINTEGER4(idx_node_nx) + idx_node_nx = FLATIDX(nx, idx_y, isurf) + DO idx_dim=1,3 + CALL PUSHREAL8(rle1(idx_dim, idx_strip)) + rle1(idx_dim, idx_strip) = mesh_surf(idx_dim, idx_node) + ENDDO +C +C Strip right side + chord1(idx_strip) = SQRT((mesh_surf(1, idx_node_nx)-mesh_surf( + + 1, idx_node))**2 + (mesh_surf(3, idx_node_nx)-mesh_surf(3, + + idx_node))**2) +C + CALL PUSHINTEGER4(idx_node_yp1) + idx_node_yp1 = FLATIDX(1, idx_y + 1, isurf) + CALL PUSHINTEGER4(idx_node_nx_yp1) + idx_node_nx_yp1 = FLATIDX(nx, idx_y + 1, isurf) + DO idx_dim=1,3 + CALL PUSHREAL8(rle2(idx_dim, idx_strip)) + rle2(idx_dim, idx_strip) = mesh_surf(idx_dim, idx_node_yp1) + ENDDO +C Strip mid-point + chord2(idx_strip) = SQRT((mesh_surf(1, idx_node_nx_yp1)- + + mesh_surf(1, idx_node_yp1))**2 + (mesh_surf(3, + + idx_node_nx_yp1)-mesh_surf(3, idx_node_yp1))**2) +C +C Since the strips are linear SPANWISE we can just interpolate + DO idx_dim=1,3 + CALL PUSHREAL8(rle(idx_dim, idx_strip)) + rle(idx_dim, idx_strip) = (rle1(idx_dim, idx_strip)+rle2( + + idx_dim, idx_strip))/2. +C The strips are not necessarily linear chord wise but by definition the chord value is +C so we can interpolate + ENDDO +C Strip geometric incidence angle at the mid-point +C This is strip incidence angle is computed from the LE and TE points +C of the given geometry and is completely independent of AINC +C This quantity is needed to correctly handle nonplanar meshes and is only needed if the mesh isnt flattened + CALL PUSHREAL8(chord(idx_strip)) + chord(idx_strip) = (chord1(idx_strip)+chord2(idx_strip))/2. +C +C Strip width +C +C Strip LE and TE sweep slopes +C +C Compute chord projections and strip twists +C In AVL the AINCS are not interpolated. The chord projections are +C So we have to replicate this effect. +C LINEAR interpolation over the strip: left, right, and midpoint +C +C + CALL PUSHINTEGER4(idx_nodel) + idx_nodel = FLATIDX(1, iptl, isurf) +C f1 = (mesh_surf(2,idx_node)-mesh_surf(2,idx_nodel))/ +C & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) +C f2 = (mesh_surf(2,idx_node_yp1)-mesh_surf(2,idx_nodel))/ +C & (mesh_surf(2,idx_noder)-mesh_surf(2,idx_nodel)) +C fc = (((mesh_surf(2,idx_node_yp1)+mesh_surf(2,idx_node))/2.) +C & -mesh_surf(2,idx_nodel))/(mesh_surf(2,idx_noder) +C & -mesh_surf(2,idx_nodel)) +C the above expressions will always evaluate to the following for individual strips + CALL PUSHINTEGER4(idx_noder) + idx_noder = FLATIDX(1, iptr, isurf) +C +C +C Strip left side incidence +C CHSIN = CHSINL + f1*(CHSINR-CHSINL) +C CHCOS = CHCOSL + f1*(CHCOSR-CHCOSL) + fc = 0.5 +C +C Strip right side incidence +C CHSIN = CHSINL + f2*(CHSINR-CHSINL) +C CHCOS = CHCOSL + f2*(CHCOSR-CHCOSL) +C +C Strip mid-point incidence +C + CALL PUSHREAL8(chsin) + chsin = chsinl + fc*(chsinr-chsinl) + CALL PUSHREAL8(chcos) + chcos = chcosl + fc*(chcosr-chcosl) +C Set dv gains for incidence angles +C Bring over the routine for this from make surf +C + DO n=1,ndesign + CALL PUSHREAL8(chsin_g) + chsin_g = (1.0-fc)*chsinl_g(n) + fc*chsinr_g(n) + CALL PUSHREAL8(chcos_g) + chcos_g = (1.0-fc)*chcosl_g(n) + fc*chcosr_g(n) +C We have to now setup any control surfaces we defined for this strip +C Bring over the routine for this from makesurf but modified for a strip + ENDDO +C + DO n=1,ncontrol + CALL PUSHINTEGER4(icl) + icl = isconl(n) + CALL PUSHINTEGER4(icr) + icr = isconr(n) +C + IF (icl .EQ. 0 .OR. icr .EQ. 0) THEN +C no control effect here + CALL PUSHREAL8(gainda(n)) + gainda(n) = 0. + CALL PUSHREAL8(xled(n)) + xled(n) = 0. + CALL PUSHREAL8(xted(n)) + xted(n) = 0. +C +C +C +C + CALL PUSHCONTROL1B(0) + ELSE +C control variable # N is active here +C SAB Note: This interpolation ensures that the hinge line is +C is linear which I think it is an ok assumption for arbitrary wings as long as the user is aware +C A curve hinge line could work if needed if we just interpolate XHINGED and scaled by local chord + CALL PUSHREAL8(gainda(n)) + gainda(n) = gaind(icl, iptl, isurf)*(1.0-fc) + gaind(icr, + + iptr, isurf)*fc +C + xhd = chordl*xhinged(icl, iptl, isurf)*(1.0-fc) + chordr* + + xhinged(icr, iptr, isurf)*fc + IF (xhd .GE. 0.0) THEN +C TE control surface, with hinge at XHD + CALL PUSHREAL8(xled(n)) + xled(n) = xhd + CALL PUSHREAL8(xted(n)) + xted(n) = chord(idx_strip) + CALL PUSHCONTROL1B(0) + ELSE +C LE control surface, with hinge at -XHD + CALL PUSHREAL8(xled(n)) + xled(n) = 0.0 + CALL PUSHREAL8(xted(n)) + xted(n) = -xhd + CALL PUSHCONTROL1B(1) + END IF +C + CALL PUSHREAL8(vhx) + vhx = vhinged(1, icl, iptl, isurf)*xyzscal(1, isurf) + CALL PUSHREAL8(vhy) + vhy = vhinged(2, icl, iptl, isurf)*xyzscal(2, isurf) + CALL PUSHREAL8(vhz) + vhz = vhinged(3, icl, iptl, isurf)*xyzscal(3, isurf) + CALL PUSHREAL8(vsq) + vsq = vhx**2 + vhy**2 + vhz**2 + IF (vsq .EQ. 0.0) THEN + IF (chordr*xhinged(icr, iptr, isurf) .GE. 0.) THEN + abs0 = chordr*xhinged(icr, iptr, isurf) + CALL PUSHCONTROL1B(1) + ELSE + abs0 = -(chordr*xhinged(icr, iptr, isurf)) + CALL PUSHCONTROL1B(0) + END IF + IF (chordl*xhinged(icl, iptl, isurf) .GE. 0.) THEN + abs1 = chordl*xhinged(icl, iptl, isurf) + CALL PUSHCONTROL1B(0) + ELSE + abs1 = -(chordl*xhinged(icl, iptl, isurf)) + CALL PUSHCONTROL1B(1) + END IF +C default: set hinge vector along hingeline +C We are just setting the hinge line across the section +C this assumes the hinge is linear even for a nonlinear wing + vhx = mesh_surf(1, idx_noder) + abs0 - mesh_surf(1, + + idx_nodel) - abs1 + vhy = mesh_surf(2, idx_noder) - mesh_surf(2, idx_nodel) + vhz = mesh_surf(3, idx_noder) - mesh_surf(3, idx_nodel) + CALL PUSHREAL8(vhx) + vhx = vhx*xyzscal(1, isurf) + CALL PUSHREAL8(vhy) + vhy = vhy*xyzscal(2, isurf) + CALL PUSHREAL8(vhz) + vhz = vhz*xyzscal(3, isurf) + vsq = vhx**2 + vhy**2 + vhz**2 + CALL PUSHCONTROL1B(0) + ELSE + CALL PUSHCONTROL1B(1) + END IF +C + CALL PUSHREAL8(vmod) + vmod = SQRT(vsq) +C +C + CALL PUSHCONTROL1B(1) + END IF + ENDDO +C Set the panel (vortex) geometry data +C Accumulate the strip element indicies and start counting vorticies +C + IF (idx_strip .EQ. 1) THEN + ijfrst(idx_strip) = 1 + ELSE + ijfrst(idx_strip) = ijfrst(idx_strip-1) + nvstrp(idx_strip-1 + + ) + END IF + idx_vor = ijfrst(idx_strip) +C Associate the strip with the surface + nvstrp(idx_strip) = nvc(isurf) +C +C Prepare for cross section interpolation +C + nsl = nasec(iptl, isurf) +C CHORDC = CHORD(idx_strip) +C Funny story. this original line is now valid now that we interpolate over the strip + nsr = nasec(iptr, isurf) +C +C +C +C Suggestion from Hal Yougren for non linear sections: +C clafc = (1.-fc)*clafl + fc*clafr +C loop over vorticies for the strip + CALL PUSHREAL8(clafc) + clafc = (1.-fc)*(chordl/chord(idx_strip))*clafl + fc*(chordr/ + + chord(idx_strip))*clafr +C +C Left bound vortex points + DO idx_x=1,nvc(isurf) +C Compute the panel left side chord + CALL PUSHINTEGER4(idx_node) + idx_node = FLATIDX(idx_x, idx_y, isurf) + CALL PUSHREAL8(dc1) + dc1 = SQRT((mesh_surf(1, idx_node+1)-mesh_surf(1, idx_node)) + + **2 + (mesh_surf(3, idx_node+1)-mesh_surf(3, idx_node))**2 + + ) +C Right bound vortex points +C + IF (lmeshflat(isurf)) THEN +C Place vortex at panel quarter chord of the flat mesh +C Compute the panel left side angle +C Place vortex at panel quarter chord of the true mesh + CALL PUSHREAL8(a1) + a1 = ATAN2(mesh_surf(3, idx_node+1) - mesh_surf(3, + + idx_node), mesh_surf(1, idx_node+1) - mesh_surf(1, + + idx_node)) + CALL PUSHCONTROL1B(0) + ELSE +C Compute the panel left side angle +C Place vortex at panel quarter chord + CALL PUSHREAL8(a1) + a1 = ATAN2(mesh_surf(3, idx_node+1) - mesh_surf(3, + + idx_node), mesh_surf(1, idx_node+1) - mesh_surf(1, + + idx_node)) +C Make a copy in the true mesh array for post processing + CALL PUSHCONTROL1B(1) + END IF +C Compute the panel right side chord + CALL PUSHINTEGER4(idx_node_yp1) + idx_node_yp1 = FLATIDX(idx_x, idx_y + 1, isurf) + CALL PUSHREAL8(dc2) + dc2 = SQRT((mesh_surf(1, idx_node_yp1+1)-mesh_surf(1, + + idx_node_yp1))**2 + (mesh_surf(3, idx_node_yp1+1)- + + mesh_surf(3, idx_node_yp1))**2) +C Mid-point bound vortex points +C Compute the panel mid-point chord +C Panels themselves can never be curved so just interpolate the chord +C store as the panel chord in common block +C + IF (lmeshflat(isurf)) THEN +C Place vortex at panel quarter chord of the flat mesh +C +C Compute the panel right side angle +C +C Place vortex at panel quarter chord of the true mesh + CALL PUSHREAL8(a2) + a2 = ATAN2(mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1), mesh_surf(1, idx_node_yp1+1) - mesh_surf( + + 1, idx_node_yp1)) + CALL PUSHCONTROL1B(0) + ELSE +C Compute the panel right side angle +C Place vortex at panel quarter chord + CALL PUSHREAL8(a2) + a2 = ATAN2(mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1), mesh_surf(1, idx_node_yp1+1) - mesh_surf( + + 1, idx_node_yp1)) +C Make a copy in the true mesh array for post processing +C + CALL PUSHCONTROL1B(1) + END IF +C +C We need to compute the midpoint angle and panel strip chord projection +C as we need them to compute normals based on the real mesh + CALL PUSHREAL8(dxv(idx_vor)) + dxv(idx_vor) = (dc1+dc2)/2. +C project the panel chord onto the strip chord + CALL PUSHREAL8(a3) + a3 = ATAN2((mesh_surf(3, idx_node_yp1+1)+mesh_surf(3, + + idx_node+1))/2. - (mesh_surf(3, idx_node_yp1)+mesh_surf(3 + + , idx_node))/2., (mesh_surf(1, idx_node_yp1+1)+mesh_surf(1 + + , idx_node+1))/2. - (mesh_surf(1, idx_node_yp1)+mesh_surf( + + 1, idx_node))/2.) +C Panel Control points +C Y- point +C is just the panel midpoint +C + IF (lmeshflat(isurf)) THEN +C Place vortex at panel quarter chord of the flat mesh + dx3 = SQRT(((mesh_surf(1, idx_node_yp1)+mesh_surf(1, + + idx_node))/2-rle(1, idx_strip))**2 + ((mesh_surf(3, + + idx_node_yp1)+mesh_surf(3, idx_node))/2-rle(3, idx_strip + + ))**2) + CALL PUSHREAL8(rv(2, idx_vor)) + rv(2, idx_vor) = rle(2, idx_strip) + CALL PUSHREAL8(rv(3, idx_vor)) + rv(3, idx_vor) = rle(3, idx_strip) +C Place vortex at panel quarter chord of the true mesh + CALL PUSHREAL8(rv(1, idx_vor)) + rv(1, idx_vor) = rle(1, idx_strip) + dx3 + dxv(idx_vor)/4. +C + CALL PUSHCONTROL1B(0) + ELSE +C Place vortex at panel quarter chord + CALL PUSHREAL8(rv(2, idx_vor)) + rv(2, idx_vor) = (mesh_surf(2, idx_node_yp1)+mesh_surf(2, + + idx_node))/2. + CALL PUSHREAL8(rv(1, idx_vor)) + rv(1, idx_vor) = (mesh_surf(1, idx_node_yp1)+mesh_surf(1, + + idx_node))/2. + dxv(idx_vor)/4.*COS(a3) +C Make a copy in the true mesh array for post processing + CALL PUSHREAL8(rv(3, idx_vor)) + rv(3, idx_vor) = (mesh_surf(3, idx_node_yp1)+mesh_surf(3, + + idx_node))/2. + dxv(idx_vor)/4.*SIN(a3) +C + CALL PUSHCONTROL1B(1) + END IF +C +C +C Place the control point at the quarter chord + half chord*clafc +C note that clafc is a scaler so is 1. is for 2pi +C use data from vortex mid-point computation + CALL PUSHREAL8(rc(2, idx_vor)) + rc(2, idx_vor) = rv(2, idx_vor) +C Source points +C Y- point + IF (lmeshflat(isurf)) THEN + CALL PUSHREAL8(rc(1, idx_vor)) + rc(1, idx_vor) = rv(1, idx_vor) + clafc*(dxv(idx_vor)/2.) + CALL PUSHREAL8(rc(3, idx_vor)) + rc(3, idx_vor) = rv(3, idx_vor) +C + CALL PUSHCONTROL1B(0) + ELSE + CALL PUSHREAL8(rc(1, idx_vor)) + rc(1, idx_vor) = rv(1, idx_vor) + clafc*(dxv(idx_vor)/2.)* + + COS(a3) +C Make a copy in the true mesh array for post processing + CALL PUSHREAL8(rc(3, idx_vor)) + rc(3, idx_vor) = rv(3, idx_vor) + clafc*(dxv(idx_vor)/2.)* + + SIN(a3) +C + CALL PUSHCONTROL1B(1) + END IF +C +C Place the source point at the half chord +C use data from vortex mid-point computation +C add another quarter chord to the quarter chord +C Set the camber slopes for the panel +C Camber slope at control point + IF (lmeshflat(isurf)) THEN + CALL PUSHCONTROL1B(0) + ELSE + CALL PUSHCONTROL1B(1) + END IF +C +C + arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL PUSHREAL8(slopel) + CALL AKIMA(xasec(1, iptl, isurf), sasec(1, iptl, isurf), nsl + + , arg1, slopel, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip + arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL PUSHREAL8(sloper) + CALL AKIMA(xasec(1, iptr, isurf), sasec(1, iptr, isurf), nsr + + , arg1, sloper, dsdx) +C +C Camber slope at vortex mid-point +C + arg1 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL PUSHREAL8(slopel) + CALL AKIMA(xasec(1, iptl, isurf), sasec(1, iptl, isurf), nsl + + , arg1, slopel, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip + arg1 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL PUSHREAL8(sloper) + CALL AKIMA(xasec(1, iptr, isurf), sasec(1, iptr, isurf), nsr + + , arg1, sloper, dsdx) +C +C Associate the panel with strip chord and component +C +C Enforce no penetration at the control point +C element inherits alpha,beta flag from surface +C +C We need to scale the control surface gains by the fraction +C of the element on the control surface +C +Cscale control gain by factor 0..1, (fraction of element on control surface) + DO n=1,ncontrol + xpt = ((mesh_surf(1, idx_node)+mesh_surf(1, idx_node_yp1)) + + /2-rle(1, idx_strip))/chord(idx_strip) +C + fracle = (xled(n)/chord(idx_strip)-xpt)/(dxv(idx_vor)/ + + chord(idx_strip)) +C + fracte = (xted(n)/chord(idx_strip)-xpt)/(dxv(idx_vor)/ + + chord(idx_strip)) + IF (0.0 .LT. fracle) THEN + y1 = fracle + CALL PUSHCONTROL1B(0) + ELSE + y1 = 0.0 + CALL PUSHCONTROL1B(1) + END IF + IF (1.0 .GT. y1) THEN + CALL PUSHCONTROL1B(0) + ELSE + CALL PUSHCONTROL1B(1) + END IF + IF (0.0 .LT. fracte) THEN + y2 = fracte + CALL PUSHCONTROL1B(0) + ELSE + y2 = 0.0 + CALL PUSHCONTROL1B(1) + END IF + IF (1.0 .GT. y2) THEN + CALL PUSHCONTROL1B(0) + ELSE + CALL PUSHCONTROL1B(1) + END IF + ENDDO +C Use the cross sections to generate the OML +C nodal grid associated with vortex strip (aft-panel nodes) +C NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; +C retained in (x,z) plane at this point +C Store the panel LE mid point for the next panel in the strip +C This gets used a lot here +C We use the original input mesh (true mesh) to compute points for the OML +C +C +C xptxind2 = (mesh_surf(1,idx_node_yp1+1) +C & - RLE2(1,idx_strip))/CHORD2(idx_strip) +C Interpolate cross section on left side +C +C +C Interpolate cross section on right side +C +C Compute the left aft node of panel +C X-point +C +C +C Y-point +C +C Interpolate z from sections to left aft node of panel +C +C Store left aft z-point +C +C Compute the right aft node of panel +C X-point +C +C Y-point +C +C Interpolate z from sections to right aft node of panel +C Store right aft z-point +C +C + CALL PUSHINTEGER4(idx_vor) + idx_vor = idx_vor + 1 +C End vortex loop + ENDDO + CALL PUSHINTEGER4(idx_strip) + idx_strip = idx_strip + 1 +C End strip loop +C Compute the wetted area and cave from the true mesh + ENDDO + mesh_surf_diff = 0.D0 + chcosl_g_diff = 0.D0 + chsinr_g_diff = 0.D0 + xted_diff = 0.D0 + xled_diff = 0.D0 + chsinl_g_diff = 0.D0 + chcosr_g_diff = 0.D0 + DO ispan=ny-1,1,-1 + CALL POPINTEGER4(idx_strip) + fc = 0.5 + nsl = nasec(iptl, isurf) + nsr = nasec(iptr, isurf) + chordl_diff = 0.D0 + chordr_diff = 0.D0 + clafc_diff = 0.D0 + DO idx_x=nvc(isurf),1,-1 + CALL POPINTEGER4(idx_vor) + DO n=ncontrol,1,-1 + fracte_diff = gainda(n)*dcontrol_diff(idx_vor, n) + fracle_diff = -(gainda(n)*dcontrol_diff(idx_vor, n)) + dcontrol_diff(idx_vor, n) = 0.D0 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + xpt = ((mesh_surf(1, idx_node)+mesh_surf(1, idx_node_yp1 + + ))/2-rle(1, idx_strip))/chord(idx_strip) + y2_diff = fracte_diff + ELSE + xpt = ((mesh_surf(1, idx_node)+mesh_surf(1, idx_node_yp1 + + ))/2-rle(1, idx_strip))/chord(idx_strip) + y2_diff = 0.D0 + END IF + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + fracte_diff = y2_diff + ELSE + fracte_diff = 0.D0 + END IF + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + y1_diff = fracle_diff + ELSE + y1_diff = 0.D0 + END IF + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + fracle_diff = y1_diff + ELSE + fracle_diff = 0.D0 + END IF + temp4 = chord(idx_strip)/dxv(idx_vor) + temp3 = xted(n)/chord(idx_strip) + temp_diff3 = temp4*fracte_diff/chord(idx_strip) + xpt_diff = -(temp4*fracte_diff) + temp_diff4 = (temp3-xpt)*fracte_diff/dxv(idx_vor) + chord_diff(idx_strip) = chord_diff(idx_strip) + temp_diff4 + + - temp3*temp_diff3 + dxv_diff(idx_vor) = dxv_diff(idx_vor) - temp4*temp_diff4 + xted_diff(n) = xted_diff(n) + temp_diff3 + temp4 = chord(idx_strip)/dxv(idx_vor) + temp3 = xled(n)/chord(idx_strip) + temp_diff3 = temp4*fracle_diff/chord(idx_strip) + xpt_diff = xpt_diff - temp4*fracle_diff + temp_diff4 = (temp3-xpt)*fracle_diff/dxv(idx_vor) + chord_diff(idx_strip) = chord_diff(idx_strip) + temp_diff4 + dxv_diff(idx_vor) = dxv_diff(idx_vor) - temp4*temp_diff4 + xled_diff(n) = xled_diff(n) + temp_diff3 + temp_diff4 = xpt_diff/chord(idx_strip) + chord_diff(idx_strip) = chord_diff(idx_strip) - temp3* + + temp_diff3 - ((mesh_surf(1, idx_node)+mesh_surf(1, + + idx_node_yp1))/2-rle(1, idx_strip))*temp_diff4/chord( + + idx_strip) + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + + temp_diff4/2 + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) + temp_diff4/2 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - + + temp_diff4 + ENDDO + temp_diff3 = fc*slopev_diff(idx_vor)/chord(idx_strip) + temp_diff4 = (1.-fc)*slopev_diff(idx_vor)/chord(idx_strip) + chord_diff(idx_strip) = chord_diff(idx_strip) + chordv_diff( + + idx_vor) - chordr*sloper*temp_diff3/chord(idx_strip) - + + chordl*slopel*temp_diff4/chord(idx_strip) + chordv_diff(idx_vor) = 0.D0 + slopev_diff(idx_vor) = 0.D0 + chordr_diff = chordr_diff + sloper*temp_diff3 + sloper_diff = chordr*temp_diff3 + chordl_diff = chordl_diff + slopel*temp_diff4 + slopel_diff = chordl*temp_diff4 + arg1 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL POPREAL8(sloper) + arg1_diff = 0.D0 + CALL AKIMA_B(xasec(1, iptr, isurf), xasec_diff(1, iptr, + + isurf), sasec(1, iptr, isurf), sasec_diff(1, + + iptr, isurf), nsr, arg1, arg1_diff, sloper, + + sloper_diff, dsdx) + temp_diff4 = arg1_diff/chord(idx_strip) + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp_diff4 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 + chord_diff(idx_strip) = chord_diff(idx_strip) - (rv(1, + + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + arg1 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL POPREAL8(slopel) + arg1_diff = 0.D0 + CALL AKIMA_B(xasec(1, iptl, isurf), xasec_diff(1, iptl, + + isurf), sasec(1, iptl, isurf), sasec_diff(1, + + iptl, isurf), nsl, arg1, arg1_diff, slopel, + + slopel_diff, dsdx) + temp_diff4 = arg1_diff/chord(idx_strip) + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp_diff4 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 + chord_diff(idx_strip) = chord_diff(idx_strip) - (rv(1, + + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + temp_diff4 = (1.-fc)*slopec_diff(idx_vor)/chord(idx_strip) + temp_diff3 = fc*slopec_diff(idx_vor)/chord(idx_strip) + slopec_diff(idx_vor) = 0.D0 + chordr_diff = chordr_diff + sloper*temp_diff3 + sloper_diff = chordr*temp_diff3 + chord_diff(idx_strip) = chord_diff(idx_strip) - chordr* + + sloper*temp_diff3/chord(idx_strip) - chordl*slopel* + + temp_diff4/chord(idx_strip) + chordl_diff = chordl_diff + slopel*temp_diff4 + slopel_diff = chordl*temp_diff4 + arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL POPREAL8(sloper) + arg1_diff = 0.D0 + CALL AKIMA_B(xasec(1, iptr, isurf), xasec_diff(1, iptr, + + isurf), sasec(1, iptr, isurf), sasec_diff(1, + + iptr, isurf), nsr, arg1, arg1_diff, sloper, + + sloper_diff, dsdx) + temp_diff4 = arg1_diff/chord(idx_strip) + rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + temp_diff4 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 + chord_diff(idx_strip) = chord_diff(idx_strip) - (rc(1, + + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + CALL POPREAL8(slopel) + arg1_diff = 0.D0 + CALL AKIMA_B(xasec(1, iptl, isurf), xasec_diff(1, iptl, + + isurf), sasec(1, iptl, isurf), sasec_diff(1, + + iptl, isurf), nsl, arg1, arg1_diff, slopel, + + slopel_diff, dsdx) + temp_diff4 = arg1_diff/chord(idx_strip) + rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + temp_diff4 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 + chord_diff(idx_strip) = chord_diff(idx_strip) - (rc(1, + + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + rv_diff(3, idx_vor) = rv_diff(3, idx_vor) + rs_diff(3, + + idx_vor) + dxv_diff(idx_vor) = dxv_diff(idx_vor) + rs_diff(3, idx_vor + + )/4. + rs_diff(1, idx_vor)/4. + rs_diff(3, idx_vor) = 0.D0 + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + rs_diff(1, + + idx_vor) + rs_diff(1, idx_vor) = 0.D0 + a3_diff = 0.D0 + ELSE + rv_diff(3, idx_vor) = rv_diff(3, idx_vor) + rs_diff(3, + + idx_vor) + dxv_diff(idx_vor) = dxv_diff(idx_vor) + SIN(a3)*rs_diff(3 + + , idx_vor)/4. + COS(a3)*rs_diff(1, idx_vor)/4. + a3_diff = COS(a3)*dxv(idx_vor)*rs_diff(3, idx_vor)/4. - + + SIN(a3)*dxv(idx_vor)*rs_diff(1, idx_vor)/4. + rs_diff(3, idx_vor) = 0.D0 + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + rs_diff(1, + + idx_vor) + rs_diff(1, idx_vor) = 0.D0 + END IF + rv_diff(2, idx_vor) = rv_diff(2, idx_vor) + rs_diff(2, + + idx_vor) + rs_diff(2, idx_vor) = 0.D0 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + rvmsh_diff(2, idx_vor) = rvmsh_diff(2, idx_vor) + + + rcmsh_diff(2, idx_vor) + rcmsh_diff(2, idx_vor) = 0.D0 + rvmsh_diff(3, idx_vor) = rvmsh_diff(3, idx_vor) + + + rcmsh_diff(3, idx_vor) + temp_diff4 = SIN(a3)*rcmsh_diff(3, idx_vor) + a3_diff = a3_diff + COS(a3)*clafc*dxv(idx_vor)*rcmsh_diff( + + 3, idx_vor)/2. - SIN(a3)*clafc*dxv(idx_vor)*rcmsh_diff(1 + + , idx_vor)/2. + rcmsh_diff(3, idx_vor) = 0.D0 + clafc_diff = clafc_diff + dxv(idx_vor)*temp_diff4/2. + dxv_diff(idx_vor) = dxv_diff(idx_vor) + clafc*temp_diff4/ + + 2. + rvmsh_diff(1, idx_vor) = rvmsh_diff(1, idx_vor) + + + rcmsh_diff(1, idx_vor) + temp_diff4 = COS(a3)*rcmsh_diff(1, idx_vor) + rcmsh_diff(1, idx_vor) = 0.D0 + clafc_diff = clafc_diff + dxv(idx_vor)*temp_diff4/2. + dxv + + (idx_vor)*rc_diff(1, idx_vor)/2. + dxv_diff(idx_vor) = dxv_diff(idx_vor) + clafc*temp_diff4/ + + 2. + clafc*rc_diff(1, idx_vor)/2. + CALL POPREAL8(rc(3, idx_vor)) + rv_diff(3, idx_vor) = rv_diff(3, idx_vor) + rc_diff(3, + + idx_vor) + rc_diff(3, idx_vor) = 0.D0 + CALL POPREAL8(rc(1, idx_vor)) + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + rc_diff(1, + + idx_vor) + rc_diff(1, idx_vor) = 0.D0 + ELSE + rc_diff(2, idx_vor) = rc_diff(2, idx_vor) + rcmsh_diff(2, + + idx_vor) + rcmsh_diff(2, idx_vor) = 0.D0 + rc_diff(3, idx_vor) = rc_diff(3, idx_vor) + rcmsh_diff(3, + + idx_vor) + rcmsh_diff(3, idx_vor) = 0.D0 + rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + rcmsh_diff(1, + + idx_vor) + rcmsh_diff(1, idx_vor) = 0.D0 + CALL POPREAL8(rc(3, idx_vor)) + rv_diff(3, idx_vor) = rv_diff(3, idx_vor) + rc_diff(3, + + idx_vor) + temp_diff4 = SIN(a3)*rc_diff(3, idx_vor) + a3_diff = a3_diff + COS(a3)*clafc*dxv(idx_vor)*rc_diff(3, + + idx_vor)/2. - SIN(a3)*clafc*dxv(idx_vor)*rc_diff(1, + + idx_vor)/2. + rc_diff(3, idx_vor) = 0.D0 + clafc_diff = clafc_diff + dxv(idx_vor)*temp_diff4/2. + dxv_diff(idx_vor) = dxv_diff(idx_vor) + clafc*temp_diff4/ + + 2. + CALL POPREAL8(rc(1, idx_vor)) + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + rc_diff(1, + + idx_vor) + temp_diff4 = COS(a3)*rc_diff(1, idx_vor) + rc_diff(1, idx_vor) = 0.D0 + clafc_diff = clafc_diff + dxv(idx_vor)*temp_diff4/2. + dxv_diff(idx_vor) = dxv_diff(idx_vor) + clafc*temp_diff4/ + + 2. + END IF + CALL POPREAL8(rc(2, idx_vor)) + rv_diff(2, idx_vor) = rv_diff(2, idx_vor) + rc_diff(2, + + idx_vor) + rc_diff(2, idx_vor) = 0.D0 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + dx3_diff = rv_diff(1, idx_vor) + temp4 = (mesh_surf(3, idx_node_yp1)+mesh_surf(3, idx_node) + + )/2 - rle(3, idx_strip) + temp3 = (mesh_surf(1, idx_node_yp1)+mesh_surf(1, idx_node) + + )/2 - rle(1, idx_strip) + IF (temp3**2 + temp4**2 .EQ. 0.D0) THEN + temp_diff2 = 0.D0 + ELSE + temp_diff2 = dx3_diff/(2.0*SQRT(temp3**2+temp4**2)) + END IF + temp_diff3 = 2*temp3*temp_diff2 + temp_diff4 = 2*temp4*temp_diff2 + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) + rvmsh_diff(3, idx_vor)/2. + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) + + + rvmsh_diff(3, idx_vor)/2. + dxv_diff(idx_vor) = dxv_diff(idx_vor) + SIN(a3)*rvmsh_diff + + (3, idx_vor)/4. + COS(a3)*rvmsh_diff(1, idx_vor)/4. + + + rv_diff(1, idx_vor)/4. + a3_diff = a3_diff + COS(a3)*dxv(idx_vor)*rvmsh_diff(3, + + idx_vor)/4. - SIN(a3)*dxv(idx_vor)*rvmsh_diff(1, idx_vor + + )/4. + rvmsh_diff(3, idx_vor) = 0.D0 + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) + rvmsh_diff(1, idx_vor)/2. + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + + rvmsh_diff(1, idx_vor)/2. + rvmsh_diff(1, idx_vor) = 0.D0 + mesh_surf_diff(2, idx_node_yp1) = mesh_surf_diff(2, + + idx_node_yp1) + rvmsh_diff(2, idx_vor)/2. + mesh_surf_diff(2, idx_node) = mesh_surf_diff(2, idx_node) + + + rvmsh_diff(2, idx_vor)/2. + rvmsh_diff(2, idx_vor) = 0.D0 + CALL POPREAL8(rv(1, idx_vor)) + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) + rv_diff( + + 1, idx_vor) - temp_diff3 + rv_diff(1, idx_vor) = 0.D0 + CALL POPREAL8(rv(3, idx_vor)) + rle_diff(3, idx_strip) = rle_diff(3, idx_strip) + rv_diff( + + 3, idx_vor) - temp_diff4 + rv_diff(3, idx_vor) = 0.D0 + CALL POPREAL8(rv(2, idx_vor)) + rle_diff(2, idx_strip) = rle_diff(2, idx_strip) + rv_diff( + + 2, idx_vor) + rv_diff(2, idx_vor) = 0.D0 + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) + temp_diff4/2 + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) + + + temp_diff4/2 + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) + temp_diff3/2 + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + + temp_diff3/2 + ELSE + rv_diff(3, idx_vor) = rv_diff(3, idx_vor) + rvmsh_diff(3, + + idx_vor) + rvmsh_diff(3, idx_vor) = 0.D0 + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + rvmsh_diff(1, + + idx_vor) + rvmsh_diff(1, idx_vor) = 0.D0 + rv_diff(2, idx_vor) = rv_diff(2, idx_vor) + rvmsh_diff(2, + + idx_vor) + rvmsh_diff(2, idx_vor) = 0.D0 + CALL POPREAL8(rv(3, idx_vor)) + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) + rv_diff(3, idx_vor)/2. + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) + + + rv_diff(3, idx_vor)/2. + dxv_diff(idx_vor) = dxv_diff(idx_vor) + SIN(a3)*rv_diff(3 + + , idx_vor)/4. + COS(a3)*rv_diff(1, idx_vor)/4. + a3_diff = a3_diff + COS(a3)*dxv(idx_vor)*rv_diff(3, + + idx_vor)/4. - SIN(a3)*dxv(idx_vor)*rv_diff(1, idx_vor)/ + + 4. + rv_diff(3, idx_vor) = 0.D0 + CALL POPREAL8(rv(1, idx_vor)) + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) + rv_diff(1, idx_vor)/2. + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + + rv_diff(1, idx_vor)/2. + rv_diff(1, idx_vor) = 0.D0 + CALL POPREAL8(rv(2, idx_vor)) + mesh_surf_diff(2, idx_node_yp1) = mesh_surf_diff(2, + + idx_node_yp1) + rv_diff(2, idx_vor)/2. + mesh_surf_diff(2, idx_node) = mesh_surf_diff(2, idx_node) + + + rv_diff(2, idx_vor)/2. + rv_diff(2, idx_vor) = 0.D0 + END IF + CALL POPREAL8(a3) + temp1 = (mesh_surf(1, idx_node_yp1+1)+mesh_surf(1, idx_node+ + + 1))/2. - (mesh_surf(1, idx_node_yp1)+mesh_surf(1, idx_node + + ))/2. + temp0 = (mesh_surf(3, idx_node_yp1+1)+mesh_surf(3, idx_node+ + + 1))/2. - (mesh_surf(3, idx_node_yp1)+mesh_surf(3, idx_node + + ))/2. + temp_diff0 = temp1*a3_diff/(temp0**2+temp1**2) + temp_diff = -(temp0*a3_diff/(temp0**2+temp1**2)) + mesh_surf_diff(1, idx_node_yp1+1) = mesh_surf_diff(1, + + idx_node_yp1+1) + temp_diff/2. + mesh_surf_diff(1, idx_node+1) = mesh_surf_diff(1, idx_node+1 + + ) + temp_diff/2. + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) - temp_diff/2. + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) - + + temp_diff/2. + mesh_surf_diff(3, idx_node_yp1+1) = mesh_surf_diff(3, + + idx_node_yp1+1) + temp_diff0/2. + mesh_surf_diff(3, idx_node+1) = mesh_surf_diff(3, idx_node+1 + + ) + temp_diff0/2. + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) - temp_diff0/2. + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) - + + temp_diff0/2. + CALL POPREAL8(dxv(idx_vor)) + dc1_diff = dxv_diff(idx_vor)/2. + dc2_diff = dxv_diff(idx_vor)/2. + dxv_diff(idx_vor) = 0.D0 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + dx2_diff = rv2_diff(1, idx_vor) + temp4 = mesh_surf(3, idx_node_yp1) - rle2(3, idx_strip) + temp3 = mesh_surf(1, idx_node_yp1) - rle2(1, idx_strip) + IF (temp3**2 + temp4**2 .EQ. 0.D0) THEN + temp_diff2 = 0.D0 + ELSE + temp_diff2 = dx2_diff/(2.0*SQRT(temp3**2+temp4**2)) + END IF + temp_diff3 = 2*temp3*temp_diff2 + temp_diff4 = 2*temp4*temp_diff2 + a2_diff = COS(a2)*dc2*rv2msh_diff(3, idx_vor)/4. - SIN(a2) + + *dc2*rv2msh_diff(1, idx_vor)/4. + temp1 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, + + idx_node_yp1) + temp0 = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1) + temp_diff0 = temp1*a2_diff/(temp0**2+temp1**2) + temp_diff = -(temp0*a2_diff/(temp0**2+temp1**2)) + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) + rv2msh_diff(3, idx_vor) + temp_diff4 - + + temp_diff0 + dc2_diff = dc2_diff + SIN(a2)*rv2msh_diff(3, idx_vor)/4. + + + COS(a2)*rv2msh_diff(1, idx_vor)/4. + rv2_diff(1, idx_vor + + )/4. + rv2msh_diff(3, idx_vor) = 0.D0 + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) + rv2msh_diff(1, idx_vor) + temp_diff3 - + + temp_diff + rv2msh_diff(1, idx_vor) = 0.D0 + mesh_surf_diff(2, idx_node_yp1) = mesh_surf_diff(2, + + idx_node_yp1) + rv2msh_diff(2, idx_vor) + rv2msh_diff(2, idx_vor) = 0.D0 + CALL POPREAL8(a2) + mesh_surf_diff(1, idx_node_yp1+1) = mesh_surf_diff(1, + + idx_node_yp1+1) + temp_diff + mesh_surf_diff(3, idx_node_yp1+1) = mesh_surf_diff(3, + + idx_node_yp1+1) + temp_diff0 + rle2_diff(1, idx_strip) = rle2_diff(1, idx_strip) + + + rv2_diff(1, idx_vor) - temp_diff3 + rv2_diff(1, idx_vor) = 0.D0 + rle2_diff(3, idx_strip) = rle2_diff(3, idx_strip) + + + rv2_diff(3, idx_vor) - temp_diff4 + rv2_diff(3, idx_vor) = 0.D0 + rle2_diff(2, idx_strip) = rle2_diff(2, idx_strip) + + + rv2_diff(2, idx_vor) + rv2_diff(2, idx_vor) = 0.D0 + ELSE + rv2_diff(3, idx_vor) = rv2_diff(3, idx_vor) + rv2msh_diff( + + 3, idx_vor) + rv2msh_diff(3, idx_vor) = 0.D0 + rv2_diff(1, idx_vor) = rv2_diff(1, idx_vor) + rv2msh_diff( + + 1, idx_vor) + rv2msh_diff(1, idx_vor) = 0.D0 + rv2_diff(2, idx_vor) = rv2_diff(2, idx_vor) + rv2msh_diff( + + 2, idx_vor) + rv2msh_diff(2, idx_vor) = 0.D0 + dc2_diff = dc2_diff + SIN(a2)*rv2_diff(3, idx_vor)/4. + + + COS(a2)*rv2_diff(1, idx_vor)/4. + a2_diff = COS(a2)*dc2*rv2_diff(3, idx_vor)/4. - SIN(a2)* + + dc2*rv2_diff(1, idx_vor)/4. + mesh_surf_diff(2, idx_node_yp1) = mesh_surf_diff(2, + + idx_node_yp1) + rv2_diff(2, idx_vor) + rv2_diff(2, idx_vor) = 0.D0 + CALL POPREAL8(a2) + temp1 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, + + idx_node_yp1) + temp0 = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1) + temp_diff0 = temp1*a2_diff/(temp0**2+temp1**2) + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) + rv2_diff(3, idx_vor) - temp_diff0 + rv2_diff(3, idx_vor) = 0.D0 + temp_diff = -(temp0*a2_diff/(temp0**2+temp1**2)) + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) + rv2_diff(1, idx_vor) - temp_diff + rv2_diff(1, idx_vor) = 0.D0 + mesh_surf_diff(1, idx_node_yp1+1) = mesh_surf_diff(1, + + idx_node_yp1+1) + temp_diff + mesh_surf_diff(3, idx_node_yp1+1) = mesh_surf_diff(3, + + idx_node_yp1+1) + temp_diff0 + END IF + CALL POPREAL8(dc2) + temp1 = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, + + idx_node_yp1) + temp0 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, + + idx_node_yp1) + IF (temp0**2 + temp1**2 .EQ. 0.D0) THEN + temp_diff1 = 0.D0 + ELSE + temp_diff1 = dc2_diff/(2.0*SQRT(temp0**2+temp1**2)) + END IF + temp_diff0 = 2*temp0*temp_diff1 + temp_diff = 2*temp1*temp_diff1 + mesh_surf_diff(3, idx_node_yp1+1) = mesh_surf_diff(3, + + idx_node_yp1+1) + temp_diff + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) - temp_diff + mesh_surf_diff(1, idx_node_yp1+1) = mesh_surf_diff(1, + + idx_node_yp1+1) + temp_diff0 + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) - temp_diff0 + CALL POPINTEGER4(idx_node_yp1) + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + dx1_diff = rv1_diff(1, idx_vor) + temp3 = mesh_surf(3, idx_node) - rle1(3, idx_strip) + temp2 = mesh_surf(1, idx_node) - rle1(1, idx_strip) + IF (temp2**2 + temp3**2 .EQ. 0.D0) THEN + temp_diff4 = 0.D0 + ELSE + temp_diff4 = dx1_diff/(2.0*SQRT(temp2**2+temp3**2)) + END IF + temp_diff2 = 2*temp2*temp_diff4 + temp_diff3 = 2*temp3*temp_diff4 + a1_diff = COS(a1)*dc1*rv1msh_diff(3, idx_vor)/4. - SIN(a1) + + *dc1*rv1msh_diff(1, idx_vor)/4. + temp1 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) + temp0 = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) + temp_diff0 = temp1*a1_diff/(temp0**2+temp1**2) + temp_diff = -(temp0*a1_diff/(temp0**2+temp1**2)) + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) + + + rv1msh_diff(3, idx_vor) + temp_diff3 - temp_diff0 + dc1_diff = dc1_diff + SIN(a1)*rv1msh_diff(3, idx_vor)/4. + + + COS(a1)*rv1msh_diff(1, idx_vor)/4. + rv1_diff(1, idx_vor + + )/4. + rv1msh_diff(3, idx_vor) = 0.D0 + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + + rv1msh_diff(1, idx_vor) + temp_diff2 - temp_diff + rv1msh_diff(1, idx_vor) = 0.D0 + mesh_surf_diff(2, idx_node) = mesh_surf_diff(2, idx_node) + + + rv1msh_diff(2, idx_vor) + rv1msh_diff(2, idx_vor) = 0.D0 + CALL POPREAL8(a1) + mesh_surf_diff(1, idx_node+1) = mesh_surf_diff(1, idx_node + + +1) + temp_diff + mesh_surf_diff(3, idx_node+1) = mesh_surf_diff(3, idx_node + + +1) + temp_diff0 + rle1_diff(1, idx_strip) = rle1_diff(1, idx_strip) + + + rv1_diff(1, idx_vor) - temp_diff2 + rv1_diff(1, idx_vor) = 0.D0 + rle1_diff(3, idx_strip) = rle1_diff(3, idx_strip) + + + rv1_diff(3, idx_vor) - temp_diff3 + rv1_diff(3, idx_vor) = 0.D0 + rle1_diff(2, idx_strip) = rle1_diff(2, idx_strip) + + + rv1_diff(2, idx_vor) + rv1_diff(2, idx_vor) = 0.D0 + ELSE + rv1_diff(3, idx_vor) = rv1_diff(3, idx_vor) + rv1msh_diff( + + 3, idx_vor) + rv1msh_diff(3, idx_vor) = 0.D0 + rv1_diff(1, idx_vor) = rv1_diff(1, idx_vor) + rv1msh_diff( + + 1, idx_vor) + rv1msh_diff(1, idx_vor) = 0.D0 + rv1_diff(2, idx_vor) = rv1_diff(2, idx_vor) + rv1msh_diff( + + 2, idx_vor) + rv1msh_diff(2, idx_vor) = 0.D0 + dc1_diff = dc1_diff + SIN(a1)*rv1_diff(3, idx_vor)/4. + + + COS(a1)*rv1_diff(1, idx_vor)/4. + a1_diff = COS(a1)*dc1*rv1_diff(3, idx_vor)/4. - SIN(a1)* + + dc1*rv1_diff(1, idx_vor)/4. + mesh_surf_diff(2, idx_node) = mesh_surf_diff(2, idx_node) + + + rv1_diff(2, idx_vor) + rv1_diff(2, idx_vor) = 0.D0 + CALL POPREAL8(a1) + temp1 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) + temp0 = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) + temp_diff0 = temp1*a1_diff/(temp0**2+temp1**2) + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) + + + rv1_diff(3, idx_vor) - temp_diff0 + rv1_diff(3, idx_vor) = 0.D0 + temp_diff = -(temp0*a1_diff/(temp0**2+temp1**2)) + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + + rv1_diff(1, idx_vor) - temp_diff + rv1_diff(1, idx_vor) = 0.D0 + mesh_surf_diff(1, idx_node+1) = mesh_surf_diff(1, idx_node + + +1) + temp_diff + mesh_surf_diff(3, idx_node+1) = mesh_surf_diff(3, idx_node + + +1) + temp_diff0 + END IF + CALL POPREAL8(dc1) + temp1 = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) + temp0 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) + IF (temp0**2 + temp1**2 .EQ. 0.D0) THEN + temp_diff1 = 0.D0 + ELSE + temp_diff1 = dc1_diff/(2.0*SQRT(temp0**2+temp1**2)) + END IF + temp_diff0 = 2*temp0*temp_diff1 + temp_diff = 2*temp1*temp_diff1 + mesh_surf_diff(3, idx_node+1) = mesh_surf_diff(3, idx_node+1 + + ) + temp_diff + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) - + + temp_diff + mesh_surf_diff(1, idx_node+1) = mesh_surf_diff(1, idx_node+1 + + ) + temp_diff0 + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) - + + temp_diff0 + CALL POPINTEGER4(idx_node) + ENDDO + clafr = claf(iptr, isurf) + clafl = claf(iptl, isurf) + CALL POPREAL8(clafc) + temp_diff2 = (1.-fc)*clafc_diff/chord(idx_strip) + temp_diff3 = fc*clafc_diff/chord(idx_strip) + chordr_diff = chordr_diff + clafr*temp_diff3 + clafr_diff = chordr*temp_diff3 + chord_diff(idx_strip) = chord_diff(idx_strip) - chordr*clafr* + + temp_diff3/chord(idx_strip) - chordl*clafl*temp_diff2/chord( + + idx_strip) + chordl_diff = chordl_diff + clafl*temp_diff2 + clafl_diff = chordl*temp_diff2 + DO n=ncontrol,1,-1 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + vhinge_diff(3, idx_strip, n) = 0.D0 + vhinge_diff(2, idx_strip, n) = 0.D0 + vhinge_diff(1, idx_strip, n) = 0.D0 + CALL POPREAL8(xted(n)) + xted_diff(n) = 0.D0 + CALL POPREAL8(xled(n)) + xled_diff(n) = 0.D0 + CALL POPREAL8(gainda(n)) + ELSE + vhz_diff = vhinge_diff(3, idx_strip, n)/vmod + vmod_diff = -(vhz*vhinge_diff(3, idx_strip, n)/vmod**2) - + + vhy*vhinge_diff(2, idx_strip, n)/vmod**2 - vhx* + + vhinge_diff(1, idx_strip, n)/vmod**2 + vhinge_diff(3, idx_strip, n) = 0.D0 + vhy_diff = vhinge_diff(2, idx_strip, n)/vmod + vhinge_diff(2, idx_strip, n) = 0.D0 + vhx_diff = vhinge_diff(1, idx_strip, n)/vmod + vhinge_diff(1, idx_strip, n) = 0.D0 + CALL POPREAL8(vmod) + IF (vsq .EQ. 0.D0) THEN + vsq_diff = 0.D0 + ELSE + vsq_diff = vmod_diff/(2.0*SQRT(vsq)) + END IF + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + vhx_diff = vhx_diff + 2*vhx*vsq_diff + vhy_diff = vhy_diff + 2*vhy*vsq_diff + vhz_diff = vhz_diff + 2*vhz*vsq_diff + CALL POPREAL8(vhz) + xyzscal_diff(3, isurf) = xyzscal_diff(3, isurf) + vhz* + + vhz_diff + vhz_diff = xyzscal(3, isurf)*vhz_diff + CALL POPREAL8(vhy) + xyzscal_diff(2, isurf) = xyzscal_diff(2, isurf) + vhy* + + vhy_diff + vhy_diff = xyzscal(2, isurf)*vhy_diff + CALL POPREAL8(vhx) + xyzscal_diff(1, isurf) = xyzscal_diff(1, isurf) + vhx* + + vhx_diff + vhx_diff = xyzscal(1, isurf)*vhx_diff + mesh_surf_diff(3, idx_noder) = mesh_surf_diff(3, + + idx_noder) + vhz_diff + mesh_surf_diff(3, idx_nodel) = mesh_surf_diff(3, + + idx_nodel) - vhz_diff + mesh_surf_diff(2, idx_noder) = mesh_surf_diff(2, + + idx_noder) + vhy_diff + mesh_surf_diff(2, idx_nodel) = mesh_surf_diff(2, + + idx_nodel) - vhy_diff + mesh_surf_diff(1, idx_noder) = mesh_surf_diff(1, + + idx_noder) + vhx_diff + abs0_diff = vhx_diff + mesh_surf_diff(1, idx_nodel) = mesh_surf_diff(1, + + idx_nodel) - vhx_diff + abs1_diff = -vhx_diff + vhy = vhinged(2, icl, iptl, isurf)*xyzscal(2, isurf) + vhz = vhinged(3, icl, iptl, isurf)*xyzscal(3, isurf) + vhx = vhinged(1, icl, iptl, isurf)*xyzscal(1, isurf) + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + chordl_diff = chordl_diff + xhinged(icl, iptl, isurf)* + + abs1_diff + ELSE + chordl_diff = chordl_diff - xhinged(icl, iptl, isurf)* + + abs1_diff + END IF + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + chordr_diff = chordr_diff - xhinged(icr, iptr, isurf)* + + abs0_diff + ELSE + chordr_diff = chordr_diff + xhinged(icr, iptr, isurf)* + + abs0_diff + END IF + vhx_diff = 0.D0 + vhy_diff = 0.D0 + vhz_diff = 0.D0 + vsq_diff = 0.D0 + END IF + CALL POPREAL8(vsq) + vhx_diff = vhx_diff + 2*vhx*vsq_diff + vhy_diff = vhy_diff + 2*vhy*vsq_diff + vhz_diff = vhz_diff + 2*vhz*vsq_diff + CALL POPREAL8(vhz) + xyzscal_diff(3, isurf) = xyzscal_diff(3, isurf) + vhinged( + + 3, icl, iptl, isurf)*vhz_diff + CALL POPREAL8(vhy) + xyzscal_diff(2, isurf) = xyzscal_diff(2, isurf) + vhinged( + + 2, icl, iptl, isurf)*vhy_diff + CALL POPREAL8(vhx) + xyzscal_diff(1, isurf) = xyzscal_diff(1, isurf) + vhinged( + + 1, icl, iptl, isurf)*vhx_diff + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + CALL POPREAL8(xted(n)) + chord_diff(idx_strip) = chord_diff(idx_strip) + + + xted_diff(n) + xted_diff(n) = 0.D0 + CALL POPREAL8(xled(n)) + xhd_diff = xled_diff(n) + xled_diff(n) = 0.D0 + ELSE + CALL POPREAL8(xted(n)) + xhd_diff = -xted_diff(n) + xted_diff(n) = 0.D0 + CALL POPREAL8(xled(n)) + xled_diff(n) = 0.D0 + END IF + chordl_diff = chordl_diff + (1.0-fc)*xhinged(icl, iptl, + + isurf)*xhd_diff + chordr_diff = chordr_diff + fc*xhinged(icr, iptr, isurf)* + + xhd_diff + CALL POPREAL8(gainda(n)) + END IF + CALL POPINTEGER4(icr) + CALL POPINTEGER4(icl) + ENDDO + chsin_diff = 0.D0 + chcos_diff = 0.D0 + DO n=ndesign,1,-1 + temp1 = chsin*chsin + chcos*chcos + temp_diff0 = ainc_g_diff(idx_strip, n)/temp1 + ainc_g_diff(idx_strip, n) = 0.D0 + chsin_g_diff = chcos*temp_diff0 + chcos_g_diff = -(chsin*temp_diff0) + temp_diff = -((chcos*chsin_g-chsin*chcos_g)*temp_diff0/temp1 + + ) + chcos_diff = chcos_diff + chsin_g*temp_diff0 + 2*chcos* + + temp_diff + chsin_diff = chsin_diff + 2*chsin*temp_diff - chcos_g* + + temp_diff0 + CALL POPREAL8(chcos_g) + chcosl_g_diff(n) = chcosl_g_diff(n) + (1.0-fc)*chcos_g_diff + chcosr_g_diff(n) = chcosr_g_diff(n) + fc*chcos_g_diff + CALL POPREAL8(chsin_g) + chsinl_g_diff(n) = chsinl_g_diff(n) + (1.0-fc)*chsin_g_diff + chsinr_g_diff(n) = chsinr_g_diff(n) + fc*chsin_g_diff + ENDDO + chsin_diff = chsin_diff + chcos*ainc_diff(idx_strip)/(chsin**2 + + +chcos**2) + chcos_diff = chcos_diff - chsin*ainc_diff(idx_strip)/(chsin**2 + + +chcos**2) + ainc_diff(idx_strip) = 0.D0 + CALL POPREAL8(chcos) + chcosl_diff = (1.0-fc)*chcos_diff + chcosr_diff = fc*chcos_diff + CALL POPREAL8(chsin) + chsinl_diff = (1.0-fc)*chsin_diff + chsinr_diff = fc*chsin_diff + CALL POPINTEGER4(idx_noder) + CALL POPINTEGER4(idx_nodel) + m2 = mesh_surf(2, idx_node_yp1) - mesh_surf(2, idx_node) + m3 = mesh_surf(3, idx_node_yp1) - mesh_surf(3, idx_node) + IF (m2**2 + m3**2 .EQ. 0.D0) THEN + temp_diff = 0.D0 + ELSE + temp_diff = wstrip_diff(idx_strip)/(2.0*SQRT(m2**2+m3**2)) + END IF + wstrip_diff(idx_strip) = 0.D0 + m2_diff = 2*m2*temp_diff + m3_diff = 2*m3*temp_diff + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) + m3_diff + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) - + + m3_diff + mesh_surf_diff(2, idx_node_yp1) = mesh_surf_diff(2, + + idx_node_yp1) + m2_diff + mesh_surf_diff(2, idx_node) = mesh_surf_diff(2, idx_node) - + + m2_diff + CALL POPREAL8(chord(idx_strip)) + chord1_diff(idx_strip) = chord1_diff(idx_strip) + chord_diff( + + idx_strip)/2. + chord2_diff(idx_strip) = chord2_diff(idx_strip) + chord_diff( + + idx_strip)/2. + chord_diff(idx_strip) = 0.D0 + DO idx_dim=3,1,-1 + CALL POPREAL8(rle(idx_dim, idx_strip)) + rle1_diff(idx_dim, idx_strip) = rle1_diff(idx_dim, idx_strip + + ) + rle_diff(idx_dim, idx_strip)/2. + rle2_diff(idx_dim, idx_strip) = rle2_diff(idx_dim, idx_strip + + ) + rle_diff(idx_dim, idx_strip)/2. + rle_diff(idx_dim, idx_strip) = 0.D0 + ENDDO + temp1 = mesh_surf(3, idx_node_nx_yp1) - mesh_surf(3, + + idx_node_yp1) + temp0 = mesh_surf(1, idx_node_nx_yp1) - mesh_surf(1, + + idx_node_yp1) + IF (temp0**2 + temp1**2 .EQ. 0.D0) THEN + temp_diff1 = 0.D0 + ELSE + temp_diff1 = chord2_diff(idx_strip)/(2.0*SQRT(temp0**2+temp1 + + **2)) + END IF + chord2_diff(idx_strip) = 0.D0 + temp_diff0 = 2*temp0*temp_diff1 + temp_diff = 2*temp1*temp_diff1 + mesh_surf_diff(3, idx_node_nx_yp1) = mesh_surf_diff(3, + + idx_node_nx_yp1) + temp_diff + mesh_surf_diff(3, idx_node_yp1) = mesh_surf_diff(3, + + idx_node_yp1) - temp_diff + mesh_surf_diff(1, idx_node_nx_yp1) = mesh_surf_diff(1, + + idx_node_nx_yp1) + temp_diff0 + mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + + idx_node_yp1) - temp_diff0 + DO idx_dim=3,1,-1 + CALL POPREAL8(rle2(idx_dim, idx_strip)) + mesh_surf_diff(idx_dim, idx_node_yp1) = mesh_surf_diff( + + idx_dim, idx_node_yp1) + rle2_diff(idx_dim, idx_strip) + rle2_diff(idx_dim, idx_strip) = 0.D0 + ENDDO + CALL POPINTEGER4(idx_node_nx_yp1) + CALL POPINTEGER4(idx_node_yp1) + temp1 = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) + temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) + IF (temp0**2 + temp1**2 .EQ. 0.D0) THEN + temp_diff1 = 0.D0 + ELSE + temp_diff1 = chord1_diff(idx_strip)/(2.0*SQRT(temp0**2+temp1 + + **2)) + END IF + chord1_diff(idx_strip) = 0.D0 + temp_diff0 = 2*temp0*temp_diff1 + temp_diff = 2*temp1*temp_diff1 + mesh_surf_diff(3, idx_node_nx) = mesh_surf_diff(3, idx_node_nx + + ) + temp_diff + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) - + + temp_diff + mesh_surf_diff(1, idx_node_nx) = mesh_surf_diff(1, idx_node_nx + + ) + temp_diff0 + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) - + + temp_diff0 + DO idx_dim=3,1,-1 + CALL POPREAL8(rle1(idx_dim, idx_strip)) + mesh_surf_diff(idx_dim, idx_node) = mesh_surf_diff(idx_dim, + + idx_node) + rle1_diff(idx_dim, idx_strip) + rle1_diff(idx_dim, idx_strip) = 0.D0 + ENDDO + CALL POPINTEGER4(idx_node_nx) + CALL POPINTEGER4(idx_node) + DO n=ndesign,1,-1 + CALL POPINTEGER4(ad_to4) + DO isdes=ad_to4,1,-1 + CALL POPCONTROL1B(branch) + IF (branch .NE. 0) THEN + chsinr_diff = chsinr_diff - dtr*gaing(isdes, iptr, isurf + + )*chcosr_g_diff(n) + chcosr_g_diff(n) = 0.D0 + chcosr_diff = chcosr_diff + dtr*gaing(isdes, iptr, isurf + + )*chsinr_g_diff(n) + chsinr_g_diff(n) = 0.D0 + END IF + ENDDO + CALL POPINTEGER4(ad_to3) + DO isdes=ad_to3,1,-1 + CALL POPCONTROL1B(branch) + IF (branch .NE. 0) THEN + chsinl_diff = chsinl_diff - dtr*gaing(isdes, iptl, isurf + + )*chcosl_g_diff(n) + chcosl_g_diff(n) = 0.D0 + chcosl_diff = chcosl_diff + dtr*gaing(isdes, iptl, isurf + + )*chsinl_g_diff(n) + chsinl_g_diff(n) = 0.D0 + END IF + ENDDO + chcosr_g_diff(n) = 0.D0 + chcosl_g_diff(n) = 0.D0 + chsinr_g_diff(n) = 0.D0 + chsinl_g_diff(n) = 0.D0 + ENDDO + DO n=ncontrol,1,-1 + CALL POPINTEGER4(ad_to2) + DO iscon=ad_to2,1,-1 + CALL POPCONTROL1B(branch) + ENDDO + CALL POPINTEGER4(ad_to1) + DO iscon=ad_to1,1,-1 + CALL POPCONTROL1B(branch) + ENDDO + ENDDO + aincr = aincs(iptr, isurf)*dtr + addinc(isurf)*dtr + chordr_diff = chordr_diff + COS(aincr)*chcosr_diff + SIN(aincr + + )*chsinr_diff + aincr_diff = COS(aincr)*chordr*chsinr_diff - SIN(aincr)*chordr + + *chcosr_diff + aincl = aincs(iptl, isurf)*dtr + addinc(isurf)*dtr + chordl_diff = chordl_diff + COS(aincl)*chcosl_diff + SIN(aincl + + )*chsinl_diff + aincl_diff = COS(aincl)*chordl*chsinl_diff - SIN(aincl)*chordl + + *chcosl_diff + aincs_diff(iptr, isurf) = aincs_diff(iptr, isurf) + dtr* + + aincr_diff + addinc_diff(isurf) = addinc_diff(isurf) + dtr*aincr_diff + dtr + + *aincl_diff + aincs_diff(iptl, isurf) = aincs_diff(iptl, isurf) + dtr* + + aincl_diff + claf_diff(iptr, isurf) = claf_diff(iptr, isurf) + clafr_diff + claf_diff(iptl, isurf) = claf_diff(iptl, isurf) + clafl_diff + CALL POPREAL8(chordr) + temp1 = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) + temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) + IF (temp0**2 + temp1**2 .EQ. 0.D0) THEN + temp_diff1 = 0.D0 + ELSE + temp_diff1 = chordr_diff/(2.0*SQRT(temp0**2+temp1**2)) + END IF + temp_diff0 = 2*temp0*temp_diff1 + temp_diff = 2*temp1*temp_diff1 + mesh_surf_diff(3, idx_node_nx) = mesh_surf_diff(3, idx_node_nx + + ) + temp_diff + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) - + + temp_diff + mesh_surf_diff(1, idx_node_nx) = mesh_surf_diff(1, idx_node_nx + + ) + temp_diff0 + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) - + + temp_diff0 + CALL POPINTEGER4(idx_node_nx) + CALL POPINTEGER4(idx_node) + CALL POPREAL8(chordl) + temp = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) + temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) + IF (temp0**2 + temp**2 .EQ. 0.D0) THEN + temp_diff = 0.D0 + ELSE + temp_diff = chordl_diff/(2.0*SQRT(temp0**2+temp**2)) + END IF + temp_diff0 = 2*temp0*temp_diff + temp_diff1 = 2*temp*temp_diff + mesh_surf_diff(3, idx_node_nx) = mesh_surf_diff(3, idx_node_nx + + ) + temp_diff1 + mesh_surf_diff(3, idx_node) = mesh_surf_diff(3, idx_node) - + + temp_diff1 + mesh_surf_diff(1, idx_node_nx) = mesh_surf_diff(1, idx_node_nx + + ) + temp_diff0 + mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) - + + temp_diff0 + CALL POPINTEGER4(idx_node_nx) + CALL POPINTEGER4(idx_node) + CALL POPINTEGER4(iptr) + CALL POPINTEGER4(iptl) + CALL POPINTEGER4(idx_y) + ENDDO + CALL POPINTEGER4(ad_to0) + DO idx_y=ad_to0,1,-1 + CALL POPINTEGER4(ad_to) + DO idx_x=ad_to,1,-1 + DO idx_dim=3,1,-1 + CALL POPREAL8(mesh_surf(idx_dim, idx_node)) + xyzscal_diff(idx_dim, isurf) = xyzscal_diff(idx_dim, isurf + + ) + mesh_surf(idx_dim, idx_node)*mesh_surf_diff(idx_dim + + , idx_node) + xyztran_diff(idx_dim, isurf) = xyztran_diff(idx_dim, isurf + + ) + mesh_surf_diff(idx_dim, idx_node) + mesh_surf_diff(idx_dim, idx_node) = xyzscal(idx_dim, isurf + + )*mesh_surf_diff(idx_dim, idx_node) + CALL POPINTEGER4(idx_node) + ENDDO + ENDDO + ENDDO + mshblk_diff(:, mfrst(isurf):mfrst(isurf)+nx*ny-1) = mshblk_diff( + + :, mfrst(isurf):mfrst(isurf)+nx*ny-1) + mesh_surf_diff + END IF + END + +C Differentiation of sdupl in reverse (adjoint) mode (with options i4 dr8 r8): +C gradient of useful results: rv1msh rv2msh rvmsh rcmsh rle +C chord rle1 chord1 rle2 chord2 wstrip ainc ainc_g +C rv1 rv2 rv rc dxv chordv slopev slopec dcontrol +C vhinge +C with respect to varying inputs: rv1msh rv2msh rvmsh rcmsh rle +C chord rle1 chord1 rle2 chord2 wstrip ainc ainc_g +C rv1 rv2 rv rc dxv chordv slopev slopec dcontrol +C vhinge +C + SUBROUTINE SDUPL_B(nn, ypt, msg) + INCLUDE 'AVL.INC' + INCLUDE 'AVL_ad_seeds.inc' + CHARACTER*(*) msg + INTEGER idx_vor + INTEGER nni + INTEGER klen + INTRINSIC LEN + INTEGER k + INTEGER isec + INTEGER idup + INTEGER iorg + REAL yoff + INTEGER idx_strip + INTEGER ivs + INTEGER jji + INTEGER jj + INTEGER n + INTEGER l + INTEGER ivc + INTEGER iii + INTEGER ii + REAL rsgn + REAL(kind=avl_real) tmp + REAL(kind=avl_real) tmp0 + REAL(kind=avl_real) tmp1 + REAL(kind=avl_real) tmp_diff + REAL(kind=avl_real) tmp2 + REAL(kind=avl_real) tmp_diff0 + REAL(kind=avl_real) tmp3 + REAL(kind=avl_real) tmp_diff1 + REAL(kind=avl_real) tmp4 + REAL(kind=avl_real) tmp_diff2 + REAL(kind=avl_real) tmp5 + REAL(kind=avl_real) tmp6 + REAL(kind=avl_real) tmp_diff3 + REAL(kind=avl_real) tmp7 + REAL(kind=avl_real) tmp8 + REAL(kind=avl_real) tmp_diff4 + REAL(kind=avl_real) tmp9 + REAL(kind=avl_real) tmp_diff5 + REAL(kind=avl_real) tmp10 + REAL(kind=avl_real) tmp11 + REAL(kind=avl_real) tmp_diff6 + REAL(kind=avl_real) tmp12 + REAL(kind=avl_real) tmp_diff7 + REAL(kind=avl_real) tmp13 + REAL(kind=avl_real) tmp_diff8 + REAL(kind=avl_real) tmp14 + REAL(kind=avl_real) tmp15 + REAL(kind=avl_real) tmp16 + REAL(kind=avl_real) tmp17 + REAL(kind=avl_real) tmp18 + REAL(kind=avl_real) tmp_diff9 + REAL(kind=avl_real) tmp19 + REAL(kind=avl_real) tmp_diff10 + REAL(kind=avl_real) tmp20 + REAL(kind=avl_real) tmp_diff11 + REAL(kind=avl_real) tmp21 + REAL(kind=avl_real) tmp_diff12 + REAL(kind=avl_real) tmp22 + REAL(kind=avl_real) tmp_diff13 + REAL(kind=avl_real) tmp23 + REAL(kind=avl_real) tmp_diff14 + REAL(kind=avl_real) tmp24 + REAL(kind=avl_real) tmp_diff15 + REAL(kind=avl_real) tmp25 + REAL(kind=avl_real) tmp_diff16 + REAL(kind=avl_real) tmp26 + REAL(kind=avl_real) tmp_diff17 + REAL(kind=avl_real) tmp27 + REAL(kind=avl_real) tmp28 + REAL(kind=avl_real) tmp_diff18 + REAL(kind=avl_real) tmp29 + REAL(kind=avl_real) tmp_diff19 + REAL(kind=avl_real) tmp30 + REAL(kind=avl_real) tmp_diff20 + REAL(kind=avl_real) tmp31 + REAL(kind=avl_real) tmp_diff21 + REAL(kind=avl_real) tmp32 + REAL(kind=avl_real) tmp_diff22 + REAL(kind=avl_real) tmp33 + REAL(kind=avl_real) tmp_diff23 + REAL(kind=avl_real) tmp34 + REAL(kind=avl_real) tmp_diff24 + REAL(kind=avl_real) tmp35 + REAL(kind=avl_real) tmp_diff25 + INTEGER ad_count + INTEGER i + INTEGER*4 branch + INTEGER ad_to + INTEGER ad_to0 + INTEGER ad_to1 + INTEGER ad_count0 + INTEGER i0 + INTEGER ii3 + INTEGER ii2 + INTEGER ii1 + INTEGER nn + REAL ypt +C +C + nni = nn + 1 + IF (nni .GT. nfmax) THEN + STOP + ELSE +C + klen = LEN(stitle(nn)) + ad_count = 1 + DO k=klen,1,-1 + IF (stitle(nn)(k:k) .NE. ' ') THEN + GOTO 100 + ELSE + ad_count = ad_count + 1 + END IF + ENDDO + CALL PUSHCONTROL1B(0) + CALL PUSHINTEGER4(ad_count) + CALL PUSHINTEGER4(ivs) + CALL PUSHCONTROL1B(0) + GOTO 110 + 100 CALL PUSHCONTROL1B(1) + CALL PUSHINTEGER4(ad_count) + CALL PUSHINTEGER4(ivs) + CALL PUSHCONTROL1B(0) +C +C---- duplicate surface is assumed to be the same logical component surface +C +C---- same various logical flags +C IFRST(NNI) = NVOR + 1 + 110 lsurfmsh(nni) = lsurfmsh(nn) +C +C---- accumulate stuff for new image surface +C JFRST(NNI) = NSTRIP + 1 + jfrst(nni) = jfrst(nni-1) + nj(nni-1) + nj(nni) = nj(nn) + nk(nni) = nk(nn) +C + nvc(nni) = nk(nni) + nvs(nni) = nj(nni) +C +C--- Note hinge axis is flipped to reverse the Y component of the hinge C vector. This means that deflections need to be reversed for image C surfaces. C @@ -2324,14 +4106,14 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) CALL PUSHINTEGER4(n - 1) C DO n=1,ncontrol - tmp9 = vrefl(jj, n) - vrefl(jji, n) = tmp9 + tmp10 = vrefl(jj, n) + vrefl(jji, n) = tmp10 C C - ENDDO - CALL PUSHINTEGER4(n - 1) C IJFRST(JJI) = NVOR + 1 C IJFRST(JJI) = IJFRST(NSTRIP - 1) + NVC(NNI) + ENDDO + CALL PUSHINTEGER4(n - 1) C C--- The defined section for image strip is flagged with (-) ijfrst(jji) = ijfrst(jji-1) + nvstrp(jji-1) @@ -2351,6 +4133,12 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) iii = ijfrst(jji) + ivc - 1 CALL PUSHINTEGER4(ii) ii = ijfrst(jj) + ivc - 1 +C Duplicate mesh data if we are using a mesh + IF (lsurfmsh(nn)) THEN + CALL PUSHCONTROL1B(1) + ELSE + CALL PUSHCONTROL1B(0) + END IF C DO n=1,ncontrol Ccc RSGN = SIGN( 1.0 , VREFL(JJ,N) ) @@ -2385,6 +4173,26 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) IF (i0 .EQ. 1) THEN CALL POPCONTROL1B(branch) IF (branch .NE. 0) THEN + DO ii1=1,nvor + DO ii2=1,3 + rv1msh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rv2msh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rvmsh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rcmsh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO DO ii1=1,NSTRIP DO ii2=1,3 rle_diff(ii2, ii1) = 0.D0 @@ -2468,12 +4276,51 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) ELSE CALL POPINTEGER4(ad_to1) DO n=ad_to1,1,-1 - tmp_diff19 = dcontrol_diff(iii, n) + tmp_diff25 = dcontrol_diff(iii, n) dcontrol_diff(iii, n) = 0.D0 dcontrol_diff(ii, n) = dcontrol_diff(ii, n) - rsgn* - + tmp_diff19 + + tmp_diff25 CALL POPREAL8(rsgn) ENDDO + CALL POPCONTROL1B(branch) + IF (branch .NE. 0) THEN + tmp_diff24 = rcmsh_diff(3, iii) + rcmsh_diff(3, iii) = 0.D0 + rcmsh_diff(3, ii) = rcmsh_diff(3, ii) + tmp_diff24 + tmp_diff23 = rcmsh_diff(2, iii) + rcmsh_diff(2, iii) = 0.D0 + rcmsh_diff(2, ii) = rcmsh_diff(2, ii) - tmp_diff23 + tmp_diff22 = rcmsh_diff(1, iii) + rcmsh_diff(1, iii) = 0.D0 + rcmsh_diff(1, ii) = rcmsh_diff(1, ii) + tmp_diff22 + tmp_diff21 = rvmsh_diff(3, iii) + rvmsh_diff(3, iii) = 0.D0 + rvmsh_diff(3, ii) = rvmsh_diff(3, ii) + tmp_diff21 + tmp_diff20 = rvmsh_diff(2, iii) + rvmsh_diff(2, iii) = 0.D0 + rvmsh_diff(2, ii) = rvmsh_diff(2, ii) - tmp_diff20 + tmp_diff19 = rvmsh_diff(1, iii) + rvmsh_diff(1, iii) = 0.D0 + rvmsh_diff(1, ii) = rvmsh_diff(1, ii) + tmp_diff19 + rv1msh_diff(3, ii) = rv1msh_diff(3, ii) + rv2msh_diff(3 + + , iii) + rv2msh_diff(3, iii) = 0.D0 + rv1msh_diff(2, ii) = rv1msh_diff(2, ii) - rv2msh_diff(2 + + , iii) + rv2msh_diff(2, iii) = 0.D0 + rv1msh_diff(1, ii) = rv1msh_diff(1, ii) + rv2msh_diff(1 + + , iii) + rv2msh_diff(1, iii) = 0.D0 + rv2msh_diff(3, ii) = rv2msh_diff(3, ii) + rv1msh_diff(3 + + , iii) + rv1msh_diff(3, iii) = 0.D0 + rv2msh_diff(2, ii) = rv2msh_diff(2, ii) - rv1msh_diff(2 + + , iii) + rv1msh_diff(2, iii) = 0.D0 + rv2msh_diff(1, ii) = rv2msh_diff(1, ii) + rv1msh_diff(1 + + , iii) + rv1msh_diff(1, iii) = 0.D0 + END IF tmp_diff18 = chordv_diff(iii) chordv_diff(iii) = 0.D0 chordv_diff(ii) = chordv_diff(ii) + tmp_diff18 @@ -2591,14 +4438,16 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) C Differentiation of encalc in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: ess ensy ensz xsref ysref zsref C rv1 rv2 rv enc env enc_d -C with respect to varying inputs: ess ensy ensz xsref ysref zsref -C ainc ainc_g rv1 rv2 rv slopev slopec dcontrol -C vhinge enc env enc_d +C with respect to varying inputs: rv1msh rv2msh rvmsh rcmsh ess +C ensy ensz xsref ysref zsref ainc ainc_g rv1 rv2 +C rv slopev slopec dcontrol vhinge enc env enc_d C BDUPL C C C C +C Also checks if surface has been assigned a point cloud mesh +C and uses the real mesh to compute normals if it is SUBROUTINE ENCALC_B() INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' @@ -2607,6 +4456,8 @@ SUBROUTINE ENCALC_B() REAL ep_diff(3), eq_diff(3), es_diff(3), eb_diff(3), ec_diff(3), + ecxb_diff(3) REAL ec_g(3, ndmax), ecxb_g(3) + REAL(kind=avl_real) dchstrip, dxt, dyt, dzt, ec_msh(3) + REAL(kind=avl_real) dxt_diff, dyt_diff, dzt_diff, ec_msh_diff(3) INTEGER j INTEGER i REAL dxle @@ -2633,12 +4484,6 @@ SUBROUTINE ENCALC_B() REAL ayte_diff REAL azte REAL azte_diff - REAL dxt - REAL dxt_diff - REAL dyt - REAL dyt_diff - REAL dzt - REAL dzt_diff INTRINSIC SQRT INTEGER nv INTEGER ii @@ -2668,11 +4513,18 @@ SUBROUTINE ENCALC_B() REAL endot REAL endot_diff REAL DOT - REAL temp - REAL temp0 - REAL temp_diff - REAL temp_diff0 - INTEGER branch + REAL(kind=avl_real) temp + REAL(kind=avl_real) temp0 + REAL(kind=avl_real) temp_diff + REAL(kind=avl_real) temp_diff0 + REAL temp_diff1 + REAL(kind=avl_real) temp1 + REAL(kind=avl_real) temp_diff2 + REAL(kind=avl_real) temp_diff3 + REAL temp_diff4 + INTEGER ad_count + INTEGER i0 + INTEGER*4 branch INTEGER ad_to INTEGER ii1 INTEGER ii3 @@ -2680,38 +4532,86 @@ SUBROUTINE ENCALC_B() C C...Calculate the normal vector at control points and bound vortex midpoints C +C Since we cannot seperate the encalc routine for direct mesh assignment we have to make it a branch here DO j=1,nstrip +C + IF (lsurfmsh(lssurf(j))) THEN +C Calculate normal vector for the strip (normal to X axis) +C we can't just interpolate this anymore given that +C the strip is no longer necessarily linear chordwise +C We want the spanwise unit vector for the strip at the +C chordwise location specified by SAXFR (usually set to 0.25) +C Loop over all panels in the strip until we find the one that contains +C the SAXFR position in it's projected chord. Since the panels themselves are still linear +C we can just use the bound vortex unit vector of that panel as +C the spanwise unit vector of the strip at SAXFR +C SAB: This is slow, find a better way to do this +C +C +C + dchstrip = 0.0 + CALL PUSHINTEGER4(i) + ad_count = 1 + searchsaxfr:DO i=ijfrst(j),ijfrst(j)+(nvstrp(j)-1) + dchstrip = dchstrip + dxstrpv(i) + IF (dchstrip .GE. chord(j)*saxfr) THEN + GOTO 100 + ELSE + CALL PUSHINTEGER4(i) + ad_count = ad_count + 1 + END IF + ENDDO searchsaxfr + CALL PUSHCONTROL1B(0) + CALL PUSHINTEGER4(ad_count) + GOTO 110 + 100 CALL PUSHCONTROL1B(1) + CALL PUSHINTEGER4(ad_count) +C +C + 110 CALL PUSHREAL8(dxt) + dxt = rv2msh(1, i) - rv1msh(1, i) + CALL PUSHREAL8(dyt) + dyt = rv2msh(2, i) - rv1msh(2, i) + CALL PUSHREAL8(dzt) + dzt = rv2msh(3, i) - rv1msh(3, i) +C + CALL PUSHCONTROL1B(0) + ELSE +C original encalc routine for standard AVL geometry C C...Calculate normal vector for the strip (normal to X axis) - CALL PUSHINTEGER4(i) - i = ijfrst(j) - dxle = rv2(1, i) - rv1(1, i) - dyle = rv2(2, i) - rv1(2, i) - dzle = rv2(3, i) - rv1(3, i) + CALL PUSHINTEGER4(i) + i = ijfrst(j) + dxle = rv2(1, i) - rv1(1, i) + dyle = rv2(2, i) - rv1(2, i) + dzle = rv2(3, i) - rv1(3, i) C AXLE = (RV2(1,I)+RV1(1,I))*0.5 C AYLE = (RV2(2,I)+RV1(2,I))*0.5 C AZLE = (RV2(3,I)+RV1(3,I))*0.5 C - i = ijfrst(j) + (nvstrp(j)-1) - dxte = rv2(1, i) - rv1(1, i) - dyte = rv2(2, i) - rv1(2, i) - dzte = rv2(3, i) - rv1(3, i) + i = ijfrst(j) + (nvstrp(j)-1) + dxte = rv2(1, i) - rv1(1, i) + dyte = rv2(2, i) - rv1(2, i) + dzte = rv2(3, i) - rv1(3, i) C AXTE = (RV2(1,I)+RV1(1,I))*0.5 C AYTE = (RV2(2,I)+RV1(2,I))*0.5 C AZTE = (RV2(3,I)+RV1(3,I))*0.5 C - CALL PUSHREAL8(dxt) - dxt = (1.0-saxfr)*dxle + saxfr*dxte - CALL PUSHREAL8(dyt) - dyt = (1.0-saxfr)*dyle + saxfr*dyte - CALL PUSHREAL8(dzt) - dzt = (1.0-saxfr)*dzle + saxfr*dzte + CALL PUSHREAL8(dxt) + dxt = (1.0-saxfr)*dxle + saxfr*dxte + CALL PUSHREAL8(dyt) + dyt = (1.0-saxfr)*dyle + saxfr*dyte + CALL PUSHREAL8(dzt) + dzt = (1.0-saxfr)*dzle + saxfr*dzte C + CALL PUSHCONTROL1B(1) + END IF C - ensy(j) = -(dzt/SQRT(dyt*dyt+dzt*dzt)) - ensz(j) = dyt/SQRT(dyt*dyt+dzt*dzt) C +C Treffz plane normals C + ensy(j) = -(dzt/SQRT(dyt*dyt+dzt*dzt)) + ensz(j) = dyt/SQRT(dyt*dyt+dzt*dzt) C CALL PUSHREAL8(es(1)) es(1) = 0. @@ -2726,18 +4626,40 @@ SUBROUTINE ENCALC_B() C CALL PUSHINTEGER4(i) i = ijfrst(j) + (ii-1) +C + IF (lsurfmsh(lssurf(j))) THEN +C Define unit vector along bound leg +C right h.v. pt - left h.v. pt + CALL PUSHREAL8(dxb) + dxb = rv2msh(1, i) - rv1msh(1, i) + CALL PUSHREAL8(dyb) + dyb = rv2msh(2, i) - rv1msh(2, i) + CALL PUSHREAL8(dzb) + dzb = rv2msh(3, i) - rv1msh(3, i) + CALL PUSHCONTROL1B(0) + ELSE C C...Define unit vector along bound leg C right h.v. pt - left h.v. pt - dxb = rv2(1, i) - rv1(1, i) - dyb = rv2(2, i) - rv1(2, i) - dzb = rv2(3, i) - rv1(3, i) + CALL PUSHREAL8(dxb) + dxb = rv2(1, i) - rv1(1, i) + CALL PUSHREAL8(dyb) + dyb = rv2(2, i) - rv1(2, i) + CALL PUSHREAL8(dzb) + dzb = rv2(3, i) - rv1(3, i) + CALL PUSHCONTROL1B(1) + END IF CALL PUSHREAL8(emag) emag = SQRT(dxb**2 + dyb**2 + dzb**2) CALL PUSHREAL8(eb(1)) eb(1) = dxb/emag CALL PUSHREAL8(eb(2)) eb(2) = dyb/emag +C First start by combining the contributions to the panel +C incidence from AVL incidence and camberline slope variables +C these are not actual geometric transformations of the mesh +C but rather further modifications to the chordwise vector that +C will get used to compute normals CALL PUSHREAL8(eb(3)) eb(3) = dzb/emag C @@ -2755,20 +4677,75 @@ SUBROUTINE ENCALC_B() C CALL PUSHREAL8(sinc) sinc = SIN(ang) + CALL PUSHREAL8(cosc) cosc = COS(ang) - CALL PUSHREAL8(ec(1)) - ec(1) = cosc - CALL PUSHREAL8(ec(2)) - ec(2) = -(sinc*es(2)) -C EC = rotation of strip normal vector? or along chord? - CALL PUSHREAL8(ec(3)) - ec(3) = -(sinc*es(3)) +C + IF (lsurfmsh(lssurf(j))) THEN +C direct mesh assignemnt branch +C now we compute the chordwise panel vector +C note that panel`s chordwise vector has contributions +C from both the geometry itself and the incidence modification +C from the AVL AINC and camber slope variables +C Get the geometric chordwise vector using RVMSH and RCMSH which should +C be located in the same plane given that each individual panel is a +C plane +C +C + CALL PUSHREAL8(emag) + emag = SQRT((rcmsh(1, i)-rvmsh(1, i))**2 + (rcmsh(2, i)- + + rvmsh(2, i))**2 + (rcmsh(3, i)-rvmsh(3, i))**2) + CALL PUSHREAL8(ec_msh(1)) + ec_msh(1) = (rcmsh(1, i)-rvmsh(1, i))/emag + CALL PUSHREAL8(ec_msh(2)) + ec_msh(2) = (rcmsh(2, i)-rvmsh(2, i))/emag +C Now we have to rotate this vector by the incidence contribution from AINC and CAMBER +C However, this rotation needs to be done about the local y-axis of the wing +C Earlier we computed ES the normal vector of the strip projected to the Trefftz plane +C The axis we need to rotate about is the one purpendicular to this ES. +C As a result all panel normals in a given strip will be rotated about the same axis defined by the that strip +C The components of the rotation axis are obtained from ES as follows +C rot_axis(1) = 0 +C rot_axis(2) = -ES(3) +C rot_axis(3) = ES(2) +C We can then multiply ec_msh by the rotation matrix for a rotation about an arbitrary axis +C see https://pubs.aip.org/aapt/ajp/article/44/1/63/1050167/Formalism-for-the-rotation-matrix-of-rotations +C Note that standard AVL also does this exact same thing but since they always rotate the vector [1,0,0] +C the result collapses into the ridiculously simple expression for EC that you see in the other branch + CALL PUSHREAL8(ec_msh(3)) + ec_msh(3) = (rcmsh(3, i)-rvmsh(3, i))/emag +C +C + CALL PUSHREAL8(ec(1)) + ec(1) = cosc*ec_msh(1) + es(2)*sinc*ec_msh(2) + es(3)*sinc* + + ec_msh(3) + CALL PUSHREAL8(ec(2)) + ec(2) = -(es(2)*sinc) + (es(3)**2*(1-cosc)+cosc)*ec_msh(2) - + + es(2)*es(3)*(1-cosc)*ec_msh(3) + CALL PUSHREAL8(ec(3)) + ec(3) = -(es(3)*sinc*ec_msh(1)) - es(2)*es(3)*(1-cosc)* + + ec_msh(2) + (es(2)**2*(1-cosc)+cosc)*ec_msh(3) +C + CALL PUSHCONTROL1B(1) + ELSE + CALL PUSHREAL8(ec(1)) + ec(1) = cosc + CALL PUSHREAL8(ec(2)) + ec(2) = -(sinc*es(2)) + CALL PUSHREAL8(ec(3)) + ec(3) = -(sinc*es(3)) + CALL PUSHCONTROL1B(0) + END IF C C...Normal vector is perpendicular to camberline vector and to the bound leg CALL PUSHREAL8ARRAY(ecxb, 3) CALL CROSS(ec, eb, ecxb) CALL PUSHREAL8(emag) emag = SQRT(ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2) +C This section is identical to the normal vector at the control +C point. The only different is that the AVL camberline slope +C is taken at the bound vortex point rather than the control point +C the geometric contributions to the normal vector at both of these +C point is identical as the lie in the plane of the same panel. IF (emag .NE. 0.0) THEN CALL PUSHREAL8(enc(1, i)) enc(1, i) = ecxb(1)/emag @@ -2802,19 +4779,40 @@ SUBROUTINE ENCALC_B() C CALL PUSHREAL8(sinc) sinc = SIN(ang) + CALL PUSHREAL8(cosc) cosc = COS(ang) - CALL PUSHREAL8(ec(1)) - ec(1) = cosc - CALL PUSHREAL8(ec(2)) - ec(2) = -(sinc*es(2)) - CALL PUSHREAL8(ec(3)) - ec(3) = -(sinc*es(3)) + IF (lsurfmsh(lssurf(j))) THEN +C direct mesh assignment branch +C see explanation in section above for control point normals +C ec_msh was already computed in that section + CALL PUSHREAL8(ec(1)) + ec(1) = cosc*ec_msh(1) + es(2)*sinc*ec_msh(2) + es(3)*sinc* + + ec_msh(3) + CALL PUSHREAL8(ec(2)) + ec(2) = -(es(2)*sinc) + (es(3)**2*(1-cosc)+cosc)*ec_msh(2) - + + es(2)*es(3)*(1-cosc)*ec_msh(3) + CALL PUSHREAL8(ec(3)) + ec(3) = -(es(3)*sinc*ec_msh(1)) - es(2)*es(3)*(1-cosc)* + + ec_msh(2) + (es(2)**2*(1-cosc)+cosc)*ec_msh(3) +C + CALL PUSHCONTROL1B(1) + ELSE + CALL PUSHREAL8(ec(1)) + ec(1) = cosc + CALL PUSHREAL8(ec(2)) + ec(2) = -(sinc*es(2)) + CALL PUSHREAL8(ec(3)) + ec(3) = -(sinc*es(3)) + CALL PUSHCONTROL1B(0) + END IF C C...Normal vector is perpendicular to camberline vector and to the bound leg CALL PUSHREAL8ARRAY(ecxb, 3) CALL CROSS(ec, eb, ecxb) CALL PUSHREAL8(emag) emag = SQRT(ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2) +C this is a pure rotation of the normal vector +C the geometric contribution from the mesh is already accounted for IF (emag .NE. 0.0) THEN CALL PUSHREAL8(env(1, i)) env(1, i) = ecxb(1)/emag @@ -2896,6 +4894,26 @@ SUBROUTINE ENCALC_B() ENDDO CALL PUSHINTEGER4(ii - 1) ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rv1msh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rv2msh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rvmsh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO + DO ii1=1,nvor + DO ii2=1,3 + rcmsh_diff(ii2, ii1) = 0.D0 + ENDDO + ENDDO DO ii1=1,NSTRIP ainc_diff(ii1) = 0.D0 ENDDO @@ -2940,10 +4958,12 @@ SUBROUTINE ENCALC_B() DO ii1=1,3 ecxb_diff(ii1) = 0.D0 ENDDO + DO ii1=1,3 + ec_msh_diff(ii1) = 0.D0 + ENDDO DO j=nstrip,1,-1 CALL POPINTEGER4(ad_to) DO ii=ad_to,1,-1 - i = ijfrst(j) + (ii-1) DO n=ncontrol,1,-1 CALL POPCONTROL1B(branch) IF (branch .NE. 0) THEN @@ -3029,26 +5049,62 @@ SUBROUTINE ENCALC_B() END IF CALL POPREAL8(emag) IF (ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 .EQ. 0.D0) THEN - temp_diff0 = 0.D0 + temp_diff4 = 0.D0 ELSE - temp_diff0 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + temp_diff4 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + 3)**2)) END IF - ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff0 - ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff0 - ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff0 + ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff4 + ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff4 + ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff4 CALL POPREAL8ARRAY(ecxb, 3) CALL CROSS_B(ec, ec_diff, eb, eb_diff, ecxb, ecxb_diff) - CALL POPREAL8(ec(3)) - sinc_diff = -(es(3)*ec_diff(3)) - es(2)*ec_diff(2) - es_diff(3) = es_diff(3) - sinc*ec_diff(3) - ec_diff(3) = 0.D0 - CALL POPREAL8(ec(2)) - es_diff(2) = es_diff(2) - sinc*ec_diff(2) - ec_diff(2) = 0.D0 - CALL POPREAL8(ec(1)) - cosc_diff = ec_diff(1) - ec_diff(1) = 0.D0 + n = 0 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + CALL POPREAL8(ec(3)) + sinc_diff = -(es(3)*ec_diff(3)) - es(2)*ec_diff(2) + es_diff(3) = es_diff(3) - sinc*ec_diff(3) + ec_diff(3) = 0.D0 + CALL POPREAL8(ec(2)) + es_diff(2) = es_diff(2) - sinc*ec_diff(2) + ec_diff(2) = 0.D0 + CALL POPREAL8(ec(1)) + cosc_diff = ec_diff(1) + ec_diff(1) = 0.D0 + ELSE + CALL POPREAL8(ec(3)) + temp_diff4 = ec_msh(3)*ec_diff(3) + temp_diff1 = -((1-cosc)*ec_msh(2)*ec_diff(3)) + temp_diff2 = -(es(2)*es(3)*ec_diff(3)) + es_diff(3) = es_diff(3) + es(2)*temp_diff1 - sinc*ec_msh(1)* + + ec_diff(3) + sinc_diff = (es(2)*ec_msh(2)+es(3)*ec_msh(3))*ec_diff(1) - + + es(3)*ec_msh(1)*ec_diff(3) - es(2)*ec_diff(2) + ec_msh_diff(1) = ec_msh_diff(1) + cosc*ec_diff(1) - es(3)* + + sinc*ec_diff(3) + cosc_diff = (1.0-es(2)**2)*temp_diff4 - ec_msh(2)*temp_diff2 + ec_msh_diff(2) = ec_msh_diff(2) + (1-cosc)*temp_diff2 + (es( + + 3)**2*(1-cosc)+cosc)*ec_diff(2) + es(2)*sinc*ec_diff(1) + es_diff(2) = es_diff(2) + es(3)*temp_diff1 + CALL POPREAL8(ec(2)) + temp_diff1 = -((1-cosc)*ec_msh(3)*ec_diff(2)) + es_diff(2) = es_diff(2) + 2*es(2)*(1-cosc)*temp_diff4 + es(3 + + )*temp_diff1 - sinc*ec_diff(2) + sinc*ec_msh(2)*ec_diff(1) + temp_diff4 = ec_msh(2)*ec_diff(2) + temp_diff2 = -(es(2)*es(3)*ec_diff(2)) + ec_msh_diff(3) = ec_msh_diff(3) + (es(2)**2*(1-cosc)+cosc)* + + ec_diff(3) + (1-cosc)*temp_diff2 + es(3)*sinc*ec_diff(1) + ec_diff(3) = 0.D0 + ec_diff(2) = 0.D0 + cosc_diff = cosc_diff + (1.0-es(3)**2)*temp_diff4 - ec_msh(3 + + )*temp_diff2 + ec_msh(1)*ec_diff(1) + es_diff(3) = es_diff(3) + es(2)*temp_diff1 + 2*es(3)*(1-cosc + + )*temp_diff4 + sinc*ec_msh(3)*ec_diff(1) + CALL POPREAL8(ec(1)) + ec_diff(1) = 0.D0 + END IF + CALL POPREAL8(cosc) ang_diff = COS(ang)*sinc_diff - SIN(ang)*cosc_diff CALL POPREAL8(sinc) DO n=ndesign,1,-1 @@ -3084,60 +5140,150 @@ SUBROUTINE ENCALC_B() END IF CALL POPREAL8(emag) IF (ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 .EQ. 0.D0) THEN - temp_diff0 = 0.D0 + temp_diff4 = 0.D0 ELSE - temp_diff0 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + temp_diff4 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + 3)**2)) END IF - ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff0 - ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff0 - ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff0 + ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff4 + ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff4 + ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff4 CALL POPREAL8ARRAY(ecxb, 3) CALL CROSS_B(ec, ec_diff, eb, eb_diff, ecxb, ecxb_diff) - CALL POPREAL8(ec(3)) - sinc_diff = -(es(3)*ec_diff(3)) - es(2)*ec_diff(2) - es_diff(3) = es_diff(3) - sinc*ec_diff(3) - ec_diff(3) = 0.D0 - CALL POPREAL8(ec(2)) - es_diff(2) = es_diff(2) - sinc*ec_diff(2) - ec_diff(2) = 0.D0 - CALL POPREAL8(ec(1)) - cosc_diff = ec_diff(1) - ec_diff(1) = 0.D0 + n = 0 + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + CALL POPREAL8(ec(3)) + sinc_diff = -(es(3)*ec_diff(3)) - es(2)*ec_diff(2) + es_diff(3) = es_diff(3) - sinc*ec_diff(3) + ec_diff(3) = 0.D0 + CALL POPREAL8(ec(2)) + es_diff(2) = es_diff(2) - sinc*ec_diff(2) + ec_diff(2) = 0.D0 + CALL POPREAL8(ec(1)) + cosc_diff = ec_diff(1) + ec_diff(1) = 0.D0 + ELSE + temp_diff2 = -(es(2)*es(3)*ec_diff(3)) + cosc_diff = -(ec_msh(2)*temp_diff2) + ec_msh_diff(2) = ec_msh_diff(2) + (1-cosc)*temp_diff2 + (es( + + 3)**2*(1-cosc)+cosc)*ec_diff(2) + es(2)*sinc*ec_diff(1) + temp_diff2 = -(es(2)*es(3)*ec_diff(2)) + CALL POPREAL8(ec(3)) + temp_diff4 = ec_msh(3)*ec_diff(3) + ec_msh_diff(3) = ec_msh_diff(3) + (es(2)**2*(1-cosc)+cosc)* + + ec_diff(3) + (1-cosc)*temp_diff2 + es(3)*sinc*ec_diff(1) + temp_diff1 = -((1-cosc)*ec_msh(2)*ec_diff(3)) + es_diff(3) = es_diff(3) + es(2)*temp_diff1 - sinc*ec_msh(1)* + + ec_diff(3) + sinc_diff = (es(2)*ec_msh(2)+es(3)*ec_msh(3))*ec_diff(1) - + + es(3)*ec_msh(1)*ec_diff(3) - es(2)*ec_diff(2) + ec_msh_diff(1) = ec_msh_diff(1) + cosc*ec_diff(1) - es(3)* + + sinc*ec_diff(3) + ec_diff(3) = 0.D0 + es_diff(2) = es_diff(2) + es(3)*temp_diff1 + 2*es(2)*(1-cosc + + )*temp_diff4 + CALL POPREAL8(ec(2)) + temp_diff1 = ec_msh(2)*ec_diff(2) + cosc_diff = cosc_diff + (1.0-es(2)**2)*temp_diff4 + (1.0-es( + + 3)**2)*temp_diff1 - ec_msh(3)*temp_diff2 + ec_msh(1)* + + ec_diff(1) + temp_diff4 = -((1-cosc)*ec_msh(3)*ec_diff(2)) + es_diff(2) = es_diff(2) + es(3)*temp_diff4 - sinc*ec_diff(2) + + + sinc*ec_msh(2)*ec_diff(1) + ec_diff(2) = 0.D0 + es_diff(3) = es_diff(3) + es(2)*temp_diff4 + 2*es(3)*(1-cosc + + )*temp_diff1 + sinc*ec_msh(3)*ec_diff(1) + CALL POPREAL8(ec(1)) + ec_diff(1) = 0.D0 + CALL POPREAL8(ec_msh(3)) + temp_diff2 = ec_msh_diff(3)/emag + ec_msh_diff(3) = 0.D0 + rcmsh_diff(3, i) = rcmsh_diff(3, i) + temp_diff2 + rvmsh_diff(3, i) = rvmsh_diff(3, i) - temp_diff2 + emag_diff = -((rcmsh(3, i)-rvmsh(3, i))*temp_diff2/emag) + CALL POPREAL8(ec_msh(2)) + temp_diff2 = ec_msh_diff(2)/emag + ec_msh_diff(2) = 0.D0 + rcmsh_diff(2, i) = rcmsh_diff(2, i) + temp_diff2 + rvmsh_diff(2, i) = rvmsh_diff(2, i) - temp_diff2 + emag_diff = emag_diff - (rcmsh(2, i)-rvmsh(2, i))*temp_diff2 + + /emag + CALL POPREAL8(ec_msh(1)) + temp_diff2 = ec_msh_diff(1)/emag + ec_msh_diff(1) = 0.D0 + rcmsh_diff(1, i) = rcmsh_diff(1, i) + temp_diff2 + rvmsh_diff(1, i) = rvmsh_diff(1, i) - temp_diff2 + emag_diff = emag_diff - (rcmsh(1, i)-rvmsh(1, i))*temp_diff2 + + /emag + CALL POPREAL8(emag) + temp0 = rcmsh(3, i) - rvmsh(3, i) + temp = rcmsh(2, i) - rvmsh(2, i) + temp1 = rcmsh(1, i) - rvmsh(1, i) + IF (temp1**2 + temp**2 + temp0**2 .EQ. 0.D0) THEN + temp_diff2 = 0.D0 + ELSE + temp_diff2 = emag_diff/(2.0*SQRT(temp1**2+temp**2+temp0**2 + + )) + END IF + temp_diff3 = 2*temp1*temp_diff2 + temp_diff = 2*temp*temp_diff2 + temp_diff0 = 2*temp0*temp_diff2 + rcmsh_diff(3, i) = rcmsh_diff(3, i) + temp_diff0 + rvmsh_diff(3, i) = rvmsh_diff(3, i) - temp_diff0 + rcmsh_diff(2, i) = rcmsh_diff(2, i) + temp_diff + rvmsh_diff(2, i) = rvmsh_diff(2, i) - temp_diff + rcmsh_diff(1, i) = rcmsh_diff(1, i) + temp_diff3 + rvmsh_diff(1, i) = rvmsh_diff(1, i) - temp_diff3 + END IF + CALL POPREAL8(cosc) ang_diff = COS(ang)*sinc_diff - SIN(ang)*cosc_diff CALL POPREAL8(sinc) DO n=ndesign,1,-1 ainc_g_diff(j, n) = ainc_g_diff(j, n) + deldes(n)*ang_diff ENDDO - dxb = rv2(1, i) - rv1(1, i) - dyb = rv2(2, i) - rv1(2, i) - CALL POPREAL8(ang) - ainc_diff(j) = ainc_diff(j) + ang_diff - slopec_diff(i) = slopec_diff(i) - ang_diff/(1.0+slopec(i)**2) - dzb = rv2(3, i) - rv1(3, i) - CALL POPREAL8(eb(3)) emag_diff = -(dzb*eb_diff(3)/emag**2) - dyb*eb_diff(2)/emag**2 + - dxb*eb_diff(1)/emag**2 - CALL POPREAL8(eb(2)) - CALL POPREAL8(eb(1)) IF (dxb**2 + dyb**2 + dzb**2 .EQ. 0.D0) THEN - temp_diff0 = 0.D0 + temp_diff1 = 0.D0 ELSE - temp_diff0 = emag_diff/(2.0*SQRT(dxb**2+dyb**2+dzb**2)) + temp_diff1 = emag_diff/(2.0*SQRT(dxb**2+dyb**2+dzb**2)) END IF - dzb_diff = eb_diff(3)/emag + 2*dzb*temp_diff0 + CALL POPREAL8(ang) + ainc_diff(j) = ainc_diff(j) + ang_diff + slopec_diff(i) = slopec_diff(i) - ang_diff/(1.0+slopec(i)**2) + CALL POPREAL8(eb(3)) + dzb_diff = eb_diff(3)/emag + 2*dzb*temp_diff1 eb_diff(3) = 0.D0 - dyb_diff = eb_diff(2)/emag + 2*dyb*temp_diff0 + CALL POPREAL8(eb(2)) + dyb_diff = eb_diff(2)/emag + 2*dyb*temp_diff1 eb_diff(2) = 0.D0 - dxb_diff = eb_diff(1)/emag + 2*dxb*temp_diff0 + CALL POPREAL8(eb(1)) + dxb_diff = eb_diff(1)/emag + 2*dxb*temp_diff1 eb_diff(1) = 0.D0 CALL POPREAL8(emag) - rv2_diff(3, i) = rv2_diff(3, i) + dzb_diff - rv1_diff(3, i) = rv1_diff(3, i) - dzb_diff - rv2_diff(2, i) = rv2_diff(2, i) + dyb_diff - rv1_diff(2, i) = rv1_diff(2, i) - dyb_diff - rv2_diff(1, i) = rv2_diff(1, i) + dxb_diff - rv1_diff(1, i) = rv1_diff(1, i) - dxb_diff + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + CALL POPREAL8(dzb) + rv2msh_diff(3, i) = rv2msh_diff(3, i) + dzb_diff + rv1msh_diff(3, i) = rv1msh_diff(3, i) - dzb_diff + CALL POPREAL8(dyb) + rv2msh_diff(2, i) = rv2msh_diff(2, i) + dyb_diff + rv1msh_diff(2, i) = rv1msh_diff(2, i) - dyb_diff + CALL POPREAL8(dxb) + rv2msh_diff(1, i) = rv2msh_diff(1, i) + dxb_diff + rv1msh_diff(1, i) = rv1msh_diff(1, i) - dxb_diff + ELSE + CALL POPREAL8(dzb) + rv2_diff(3, i) = rv2_diff(3, i) + dzb_diff + rv1_diff(3, i) = rv1_diff(3, i) - dzb_diff + CALL POPREAL8(dyb) + rv2_diff(2, i) = rv2_diff(2, i) + dyb_diff + rv1_diff(2, i) = rv1_diff(2, i) - dyb_diff + CALL POPREAL8(dxb) + rv2_diff(1, i) = rv2_diff(1, i) + dxb_diff + rv1_diff(1, i) = rv1_diff(1, i) - dxb_diff + END IF DO n=ncontrol,1,-1 enc_d_diff(3, i, n) = 0.D0 enc_d_diff(2, i, n) = 0.D0 @@ -3153,15 +5299,6 @@ SUBROUTINE ENCALC_B() es_diff(2) = 0.D0 CALL POPREAL8(es(1)) es_diff(1) = 0.D0 - azle_diff = (1.0-saxfr)*zsref_diff(j) - azte_diff = saxfr*zsref_diff(j) - zsref_diff(j) = 0.D0 - ayle_diff = (1.0-saxfr)*ysref_diff(j) - ayte_diff = saxfr*ysref_diff(j) - ysref_diff(j) = 0.D0 - axle_diff = (1.0-saxfr)*xsref_diff(j) - axte_diff = saxfr*xsref_diff(j) - xsref_diff(j) = 0.D0 temp0 = dyt*dyt + dzt*dzt temp = SQRT(temp0) IF (temp0 .EQ. 0.D0) THEN @@ -3213,37 +5350,69 @@ SUBROUTINE ENCALC_B() dyt_diff = dyt_diff + 2*dyt*temp_diff0 + 2*dyt*temp_diff dzt_diff = dzt_diff + 2*dzt*temp_diff0 + 2*dzt*temp_diff ess_diff(1, j) = 0.D0 - CALL POPREAL8(dzt) - dzle_diff = (1.0-saxfr)*dzt_diff - dzte_diff = saxfr*dzt_diff - CALL POPREAL8(dyt) - dyle_diff = (1.0-saxfr)*dyt_diff - dyte_diff = saxfr*dyt_diff - CALL POPREAL8(dxt) - dxle_diff = (1.0-saxfr)*dxt_diff - dxte_diff = saxfr*dxt_diff - rv_diff(3, i) = rv_diff(3, i) + azte_diff - rv_diff(2, i) = rv_diff(2, i) + ayte_diff - rv_diff(1, i) = rv_diff(1, i) + axte_diff - rv2_diff(3, i) = rv2_diff(3, i) + dzte_diff - rv1_diff(3, i) = rv1_diff(3, i) - dzte_diff - rv2_diff(2, i) = rv2_diff(2, i) + dyte_diff - rv1_diff(2, i) = rv1_diff(2, i) - dyte_diff - rv2_diff(1, i) = rv2_diff(1, i) + dxte_diff - rv1_diff(1, i) = rv1_diff(1, i) - dxte_diff - i = ijfrst(j) - rv_diff(3, i) = rv_diff(3, i) + azle_diff - rv_diff(2, i) = rv_diff(2, i) + ayle_diff - rv_diff(1, i) = rv_diff(1, i) + axle_diff - rv2_diff(3, i) = rv2_diff(3, i) + dzle_diff - rv1_diff(3, i) = rv1_diff(3, i) - dzle_diff - rv2_diff(2, i) = rv2_diff(2, i) + dyle_diff - rv1_diff(2, i) = rv1_diff(2, i) - dyle_diff - rv2_diff(1, i) = rv2_diff(1, i) + dxle_diff - rv1_diff(1, i) = rv1_diff(1, i) - dxle_diff - CALL POPINTEGER4(i) + CALL POPCONTROL1B(branch) + IF (branch .EQ. 0) THEN + rvmsh_diff(3, i) = rvmsh_diff(3, i) + zsref_diff(j) + zsref_diff(j) = 0.D0 + rvmsh_diff(2, i) = rvmsh_diff(2, i) + ysref_diff(j) + ysref_diff(j) = 0.D0 + rvmsh_diff(1, i) = rvmsh_diff(1, i) + xsref_diff(j) + xsref_diff(j) = 0.D0 + CALL POPREAL8(dzt) + rv2msh_diff(3, i) = rv2msh_diff(3, i) + dzt_diff + rv1msh_diff(3, i) = rv1msh_diff(3, i) - dzt_diff + CALL POPREAL8(dyt) + rv2msh_diff(2, i) = rv2msh_diff(2, i) + dyt_diff + rv1msh_diff(2, i) = rv1msh_diff(2, i) - dyt_diff + CALL POPREAL8(dxt) + rv2msh_diff(1, i) = rv2msh_diff(1, i) + dxt_diff + rv1msh_diff(1, i) = rv1msh_diff(1, i) - dxt_diff + CALL POPINTEGER4(ad_count) + DO i0=1,ad_count + IF (i0 .EQ. 1) CALL POPCONTROL1B(branch) + CALL POPINTEGER4(i) + ENDDO + ELSE + azle_diff = (1.0-saxfr)*zsref_diff(j) + azte_diff = saxfr*zsref_diff(j) + zsref_diff(j) = 0.D0 + ayle_diff = (1.0-saxfr)*ysref_diff(j) + ayte_diff = saxfr*ysref_diff(j) + ysref_diff(j) = 0.D0 + axle_diff = (1.0-saxfr)*xsref_diff(j) + axte_diff = saxfr*xsref_diff(j) + xsref_diff(j) = 0.D0 + CALL POPREAL8(dzt) + dzle_diff = (1.0-saxfr)*dzt_diff + dzte_diff = saxfr*dzt_diff + CALL POPREAL8(dyt) + dyle_diff = (1.0-saxfr)*dyt_diff + dyte_diff = saxfr*dyt_diff + CALL POPREAL8(dxt) + dxle_diff = (1.0-saxfr)*dxt_diff + dxte_diff = saxfr*dxt_diff + rv_diff(3, i) = rv_diff(3, i) + azte_diff + rv_diff(2, i) = rv_diff(2, i) + ayte_diff + rv_diff(1, i) = rv_diff(1, i) + axte_diff + rv2_diff(3, i) = rv2_diff(3, i) + dzte_diff + rv1_diff(3, i) = rv1_diff(3, i) - dzte_diff + rv2_diff(2, i) = rv2_diff(2, i) + dyte_diff + rv1_diff(2, i) = rv1_diff(2, i) - dyte_diff + rv2_diff(1, i) = rv2_diff(1, i) + dxte_diff + rv1_diff(1, i) = rv1_diff(1, i) - dxte_diff + i = ijfrst(j) + rv_diff(3, i) = rv_diff(3, i) + azle_diff + rv_diff(2, i) = rv_diff(2, i) + ayle_diff + rv_diff(1, i) = rv_diff(1, i) + axle_diff + rv2_diff(3, i) = rv2_diff(3, i) + dzle_diff + rv1_diff(3, i) = rv1_diff(3, i) - dzle_diff + rv2_diff(2, i) = rv2_diff(2, i) + dyle_diff + rv1_diff(2, i) = rv1_diff(2, i) - dyle_diff + rv2_diff(1, i) = rv2_diff(1, i) + dxle_diff + rv1_diff(1, i) = rv1_diff(1, i) - dxle_diff + CALL POPINTEGER4(i) + END IF ENDDO END C ENCALC -C diff --git a/src/ad_src/reverse_ad_src/amode_b.f b/src/ad_src/reverse_ad_src/amode_b.f index d5fbc4e..48a096f 100644 --- a/src/ad_src/reverse_ad_src/amode_b.f +++ b/src/ad_src/reverse_ad_src/amode_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of set_params in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: parval mach @@ -8,7 +8,6 @@ C C SUBROUTINE SET_PARAMS_B(ir) -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER ir @@ -32,6 +31,7 @@ SUBROUTINE SET_PARAMS_B(ir) REAL rixy REAL riyz REAL rizx +C C parval_diff(ipmach, ir) = parval_diff(ipmach, ir) + mach_diff END diff --git a/src/ad_src/reverse_ad_src/aoper_b.f b/src/ad_src/reverse_ad_src/aoper_b.f index cc1ba71..c79ab54 100644 --- a/src/ad_src/reverse_ad_src/aoper_b.f +++ b/src/ad_src/reverse_ad_src/aoper_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of calc_stab_derivs in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: cftot_d cxtot_u_ba cytot_u_ba @@ -57,16 +57,15 @@ SUBROUTINE CALC_STAB_DERIVS_B() REAL(kind=avl_real) abs1 REAL(kind=avl_real) abs2 REAL(kind=avl_real) abs2_diff - REAL(kind=8) temp_diff + REAL(kind=avl_real) temp_diff INTEGER ii1 REAL(kind=avl_real) temp_diff0 - REAL(kind=avl_real) temp_diff1 INTEGER ii2 - INTEGER branch + INTEGER*4 branch C - CALL GETSA(lnasa_sa, satype, dir) C CALL VINFAB C CALL AERO + CALL GETSA(lnasa_sa, satype, dir) C C---- set freestream velocity components from alpha, beta C @@ -212,83 +211,83 @@ SUBROUTINE CALC_STAB_DERIVS_B() cmtot_u_diff(ii2, ii1) = 0.D0 ENDDO ENDDO - temp_diff1 = 2.0*cntot_u_ba_diff(6)/bref + temp_diff0 = 2.0*cntot_u_ba_diff(6)/bref cntot_u_ba_diff(6) = 0.D0 - cmtot_u_diff(3, 6) = cmtot_u_diff(3, 6) + temp_diff1 - bref_diff = -(cmtot_u(3, 6)*temp_diff1/bref) - temp_diff1 = dir*2.0*cntot_u_ba_diff(5)/cref + cmtot_u_diff(3, 6) = cmtot_u_diff(3, 6) + temp_diff0 + bref_diff = -(cmtot_u(3, 6)*temp_diff0/bref) + temp_diff0 = dir*2.0*cntot_u_ba_diff(5)/cref cntot_u_ba_diff(5) = 0.D0 - cmtot_u_diff(3, 5) = cmtot_u_diff(3, 5) + temp_diff1 - cref_diff = -(cmtot_u(3, 5)*temp_diff1/cref) - temp_diff1 = 2.0*cntot_u_ba_diff(4)/bref + cmtot_u_diff(3, 5) = cmtot_u_diff(3, 5) + temp_diff0 + cref_diff = -(cmtot_u(3, 5)*temp_diff0/cref) + temp_diff0 = 2.0*cntot_u_ba_diff(4)/bref cntot_u_ba_diff(4) = 0.D0 - cmtot_u_diff(3, 4) = cmtot_u_diff(3, 4) + temp_diff1 - bref_diff = bref_diff - cmtot_u(3, 4)*temp_diff1/bref - temp_diff1 = dir*2.0*cmtot_u_ba_diff(6)/bref + cmtot_u_diff(3, 4) = cmtot_u_diff(3, 4) + temp_diff0 + bref_diff = bref_diff - cmtot_u(3, 4)*temp_diff0/bref + temp_diff0 = dir*2.0*cmtot_u_ba_diff(6)/bref cmtot_u_ba_diff(6) = 0.D0 - cmtot_u_diff(2, 6) = cmtot_u_diff(2, 6) + temp_diff1 - bref_diff = bref_diff - cmtot_u(2, 6)*temp_diff1/bref - temp_diff1 = 2.0*cmtot_u_ba_diff(5)/cref + cmtot_u_diff(2, 6) = cmtot_u_diff(2, 6) + temp_diff0 + bref_diff = bref_diff - cmtot_u(2, 6)*temp_diff0/bref + temp_diff0 = 2.0*cmtot_u_ba_diff(5)/cref cmtot_u_ba_diff(5) = 0.D0 - cmtot_u_diff(2, 5) = cmtot_u_diff(2, 5) + temp_diff1 - cref_diff = cref_diff - cmtot_u(2, 5)*temp_diff1/cref - temp_diff1 = dir*2.0*cmtot_u_ba_diff(4)/bref + cmtot_u_diff(2, 5) = cmtot_u_diff(2, 5) + temp_diff0 + cref_diff = cref_diff - cmtot_u(2, 5)*temp_diff0/cref + temp_diff0 = dir*2.0*cmtot_u_ba_diff(4)/bref cmtot_u_ba_diff(4) = 0.D0 - cmtot_u_diff(2, 4) = cmtot_u_diff(2, 4) + temp_diff1 - bref_diff = bref_diff - cmtot_u(2, 4)*temp_diff1/bref - temp_diff1 = 2.0*crtot_u_ba_diff(6)/bref + cmtot_u_diff(2, 4) = cmtot_u_diff(2, 4) + temp_diff0 + bref_diff = bref_diff - cmtot_u(2, 4)*temp_diff0/bref + temp_diff0 = 2.0*crtot_u_ba_diff(6)/bref crtot_u_ba_diff(6) = 0.D0 - cmtot_u_diff(1, 6) = cmtot_u_diff(1, 6) + temp_diff1 - bref_diff = bref_diff - cmtot_u(1, 6)*temp_diff1/bref - temp_diff1 = dir*2.0*crtot_u_ba_diff(5)/cref + cmtot_u_diff(1, 6) = cmtot_u_diff(1, 6) + temp_diff0 + bref_diff = bref_diff - cmtot_u(1, 6)*temp_diff0/bref + temp_diff0 = dir*2.0*crtot_u_ba_diff(5)/cref crtot_u_ba_diff(5) = 0.D0 - cmtot_u_diff(1, 5) = cmtot_u_diff(1, 5) + temp_diff1 - cref_diff = cref_diff - cmtot_u(1, 5)*temp_diff1/cref - temp_diff1 = 2.0*crtot_u_ba_diff(4)/bref + cmtot_u_diff(1, 5) = cmtot_u_diff(1, 5) + temp_diff0 + cref_diff = cref_diff - cmtot_u(1, 5)*temp_diff0/cref + temp_diff0 = 2.0*crtot_u_ba_diff(4)/bref crtot_u_ba_diff(4) = 0.D0 - cmtot_u_diff(1, 4) = cmtot_u_diff(1, 4) + temp_diff1 - bref_diff = bref_diff - cmtot_u(1, 4)*temp_diff1/bref + cmtot_u_diff(1, 4) = cmtot_u_diff(1, 4) + temp_diff0 + bref_diff = bref_diff - cmtot_u(1, 4)*temp_diff0/bref DO ii1=1,numax DO ii2=1,3 cftot_u_diff(ii2, ii1) = 0.D0 ENDDO ENDDO - temp_diff1 = 2.0*cztot_u_ba_diff(6)/bref + temp_diff0 = 2.0*cztot_u_ba_diff(6)/bref cztot_u_ba_diff(6) = 0.D0 - cftot_u_diff(3, 6) = cftot_u_diff(3, 6) + temp_diff1 - bref_diff = bref_diff - cftot_u(3, 6)*temp_diff1/bref - temp_diff1 = dir*2.0*cztot_u_ba_diff(5)/cref + cftot_u_diff(3, 6) = cftot_u_diff(3, 6) + temp_diff0 + bref_diff = bref_diff - cftot_u(3, 6)*temp_diff0/bref + temp_diff0 = dir*2.0*cztot_u_ba_diff(5)/cref cztot_u_ba_diff(5) = 0.D0 - cftot_u_diff(3, 5) = cftot_u_diff(3, 5) + temp_diff1 - cref_diff = cref_diff - cftot_u(3, 5)*temp_diff1/cref - temp_diff1 = 2.0*cztot_u_ba_diff(4)/bref + cftot_u_diff(3, 5) = cftot_u_diff(3, 5) + temp_diff0 + cref_diff = cref_diff - cftot_u(3, 5)*temp_diff0/cref + temp_diff0 = 2.0*cztot_u_ba_diff(4)/bref cztot_u_ba_diff(4) = 0.D0 - cftot_u_diff(3, 4) = cftot_u_diff(3, 4) + temp_diff1 - bref_diff = bref_diff - cftot_u(3, 4)*temp_diff1/bref - temp_diff1 = dir*2.0*cytot_u_ba_diff(6)/bref + cftot_u_diff(3, 4) = cftot_u_diff(3, 4) + temp_diff0 + bref_diff = bref_diff - cftot_u(3, 4)*temp_diff0/bref + temp_diff0 = dir*2.0*cytot_u_ba_diff(6)/bref cytot_u_ba_diff(6) = 0.D0 - cftot_u_diff(2, 6) = cftot_u_diff(2, 6) + temp_diff1 - bref_diff = bref_diff - cftot_u(2, 6)*temp_diff1/bref - temp_diff1 = 2.0*cytot_u_ba_diff(5)/cref + cftot_u_diff(2, 6) = cftot_u_diff(2, 6) + temp_diff0 + bref_diff = bref_diff - cftot_u(2, 6)*temp_diff0/bref + temp_diff0 = 2.0*cytot_u_ba_diff(5)/cref cytot_u_ba_diff(5) = 0.D0 - cftot_u_diff(2, 5) = cftot_u_diff(2, 5) + temp_diff1 - cref_diff = cref_diff - cftot_u(2, 5)*temp_diff1/cref - temp_diff1 = dir*2.0*cytot_u_ba_diff(4)/bref + cftot_u_diff(2, 5) = cftot_u_diff(2, 5) + temp_diff0 + cref_diff = cref_diff - cftot_u(2, 5)*temp_diff0/cref + temp_diff0 = dir*2.0*cytot_u_ba_diff(4)/bref cytot_u_ba_diff(4) = 0.D0 - cftot_u_diff(2, 4) = cftot_u_diff(2, 4) + temp_diff1 - bref_diff = bref_diff - cftot_u(2, 4)*temp_diff1/bref - temp_diff1 = 2.0*cxtot_u_ba_diff(6)/bref + cftot_u_diff(2, 4) = cftot_u_diff(2, 4) + temp_diff0 + bref_diff = bref_diff - cftot_u(2, 4)*temp_diff0/bref + temp_diff0 = 2.0*cxtot_u_ba_diff(6)/bref cxtot_u_ba_diff(6) = 0.D0 - cftot_u_diff(1, 6) = cftot_u_diff(1, 6) + temp_diff1 - bref_diff = bref_diff - cftot_u(1, 6)*temp_diff1/bref - temp_diff1 = dir*2.0*cxtot_u_ba_diff(5)/cref + cftot_u_diff(1, 6) = cftot_u_diff(1, 6) + temp_diff0 + bref_diff = bref_diff - cftot_u(1, 6)*temp_diff0/bref + temp_diff0 = dir*2.0*cxtot_u_ba_diff(5)/cref cxtot_u_ba_diff(5) = 0.D0 - cftot_u_diff(1, 5) = cftot_u_diff(1, 5) + temp_diff1 - cref_diff = cref_diff - cftot_u(1, 5)*temp_diff1/cref - temp_diff1 = 2.0*cxtot_u_ba_diff(4)/bref + cftot_u_diff(1, 5) = cftot_u_diff(1, 5) + temp_diff0 + cref_diff = cref_diff - cftot_u(1, 5)*temp_diff0/cref + temp_diff0 = 2.0*cxtot_u_ba_diff(4)/bref cxtot_u_ba_diff(4) = 0.D0 - cftot_u_diff(1, 4) = cftot_u_diff(1, 4) + temp_diff1 - bref_diff = bref_diff - cftot_u(1, 4)*temp_diff1/bref + cftot_u_diff(1, 4) = cftot_u_diff(1, 4) + temp_diff0 + bref_diff = bref_diff - cftot_u(1, 4)*temp_diff0/bref cmtot_u_diff(3, 3) = cmtot_u_diff(3, 3) - cntot_u_ba_diff(3) cntot_u_ba_diff(3) = 0.D0 cmtot_u_diff(3, 2) = cmtot_u_diff(3, 2) - dir*cntot_u_ba_diff(2) @@ -339,12 +338,12 @@ SUBROUTINE CALC_STAB_DERIVS_B() END IF CALL POPCONTROL1B(branch) IF (branch .NE. 0) THEN - temp_diff0 = bb_diff/(crtot_rz*cntot_be) - crtot_be_diff = crtot_be_diff + cntot_rz*temp_diff0 - cntot_rz_diff = cntot_rz_diff + crtot_be*temp_diff0 - temp_diff1 = -(crtot_be*cntot_rz*temp_diff0/(crtot_rz*cntot_be)) - crtot_rz_diff = crtot_rz_diff + cntot_be*temp_diff1 - cntot_be_diff = cntot_be_diff + crtot_rz*temp_diff1 + temp_diff = bb_diff/(crtot_rz*cntot_be) + crtot_be_diff = crtot_be_diff + cntot_rz*temp_diff + cntot_rz_diff = cntot_rz_diff + crtot_be*temp_diff + temp_diff0 = -(crtot_be*cntot_rz*temp_diff/(crtot_rz*cntot_be)) + crtot_rz_diff = crtot_rz_diff + cntot_be*temp_diff0 + cntot_be_diff = cntot_be_diff + crtot_rz*temp_diff0 bb_diff = 0.D0 END IF CALL POPCONTROL1B(branch) @@ -365,61 +364,61 @@ SUBROUTINE CALC_STAB_DERIVS_B() sm_diff = 0.D0 END IF CALL POPREAL8(cntot_rz) - temp_diff0 = dir*2.0*cntot_rz_diff/bref - cntot_rz_diff = temp_diff0 - bref_diff = bref_diff - cntot_rz*temp_diff0/bref - temp_diff0 = dir*2.0*cntot_ry_diff/cref - cntot_ry_diff = temp_diff0 - cref_diff = cref_diff - cntot_ry*temp_diff0/cref - temp_diff0 = dir*2.0*cntot_rx_diff/bref - cntot_rx_diff = temp_diff0 - bref_diff = bref_diff - cntot_rx*temp_diff0/bref - temp_diff0 = 2.0*cmtot_rz_diff/bref - cmtot_rz_diff = temp_diff0 - bref_diff = bref_diff - cmtot_rz*temp_diff0/bref - temp_diff0 = 2.0*cmtot_ry_diff/cref - cmtot_ry_diff = temp_diff0 - cref_diff = cref_diff - cmtot_ry*temp_diff0/cref - temp_diff0 = 2.0*cmtot_rx_diff/bref - cmtot_rx_diff = temp_diff0 - bref_diff = bref_diff - cmtot_rx*temp_diff0/bref + temp_diff = dir*2.0*cntot_rz_diff/bref + cntot_rz_diff = temp_diff + bref_diff = bref_diff - cntot_rz*temp_diff/bref + temp_diff = dir*2.0*cntot_ry_diff/cref + cntot_ry_diff = temp_diff + cref_diff = cref_diff - cntot_ry*temp_diff/cref + temp_diff = dir*2.0*cntot_rx_diff/bref + cntot_rx_diff = temp_diff + bref_diff = bref_diff - cntot_rx*temp_diff/bref + temp_diff = 2.0*cmtot_rz_diff/bref + cmtot_rz_diff = temp_diff + bref_diff = bref_diff - cmtot_rz*temp_diff/bref + temp_diff = 2.0*cmtot_ry_diff/cref + cmtot_ry_diff = temp_diff + cref_diff = cref_diff - cmtot_ry*temp_diff/cref + temp_diff = 2.0*cmtot_rx_diff/bref + cmtot_rx_diff = temp_diff + bref_diff = bref_diff - cmtot_rx*temp_diff/bref CALL POPREAL8(crtot_rz) - temp_diff0 = dir*2.0*crtot_rz_diff/bref - crtot_rz_diff = temp_diff0 - bref_diff = bref_diff - crtot_rz*temp_diff0/bref - temp_diff0 = dir*2.0*crtot_ry_diff/cref - crtot_ry_diff = temp_diff0 - cref_diff = cref_diff - crtot_ry*temp_diff0/cref - temp_diff0 = dir*2.0*crtot_rx_diff/bref - crtot_rx_diff = temp_diff0 - bref_diff = bref_diff - crtot_rx*temp_diff0/bref - temp_diff0 = 2.0*cdtot_rz_diff/bref - cdtot_rz_diff = temp_diff0 - bref_diff = bref_diff - cdtot_rz*temp_diff0/bref - temp_diff0 = 2.0*cdtot_ry_diff/cref - cdtot_ry_diff = temp_diff0 - cref_diff = cref_diff - cdtot_ry*temp_diff0/cref - temp_diff0 = 2.0*cdtot_rx_diff/bref - cdtot_rx_diff = temp_diff0 - bref_diff = bref_diff - cdtot_rx*temp_diff0/bref - temp_diff0 = 2.0*cytot_rz_diff/bref - cytot_rz_diff = temp_diff0 - bref_diff = bref_diff - cytot_rz*temp_diff0/bref - temp_diff0 = 2.0*cytot_ry_diff/cref - cytot_ry_diff = temp_diff0 - cref_diff = cref_diff - cytot_ry*temp_diff0/cref - temp_diff0 = 2.0*cytot_rx_diff/bref - cytot_rx_diff = temp_diff0 - bref_diff = bref_diff - cytot_rx*temp_diff0/bref - temp_diff0 = 2.0*cltot_rz_diff/bref - cltot_rz_diff = temp_diff0 - bref_diff = bref_diff - cltot_rz*temp_diff0/bref - temp_diff0 = 2.0*cltot_ry_diff/cref - cltot_ry_diff = temp_diff0 - cref_diff = cref_diff - cltot_ry*temp_diff0/cref - temp_diff0 = 2.0*cltot_rx_diff/bref - cltot_rx_diff = temp_diff0 - bref_diff = bref_diff - cltot_rx*temp_diff0/bref + temp_diff = dir*2.0*crtot_rz_diff/bref + crtot_rz_diff = temp_diff + bref_diff = bref_diff - crtot_rz*temp_diff/bref + temp_diff = dir*2.0*crtot_ry_diff/cref + crtot_ry_diff = temp_diff + cref_diff = cref_diff - crtot_ry*temp_diff/cref + temp_diff = dir*2.0*crtot_rx_diff/bref + crtot_rx_diff = temp_diff + bref_diff = bref_diff - crtot_rx*temp_diff/bref + temp_diff = 2.0*cdtot_rz_diff/bref + cdtot_rz_diff = temp_diff + bref_diff = bref_diff - cdtot_rz*temp_diff/bref + temp_diff = 2.0*cdtot_ry_diff/cref + cdtot_ry_diff = temp_diff + cref_diff = cref_diff - cdtot_ry*temp_diff/cref + temp_diff = 2.0*cdtot_rx_diff/bref + cdtot_rx_diff = temp_diff + bref_diff = bref_diff - cdtot_rx*temp_diff/bref + temp_diff = 2.0*cytot_rz_diff/bref + cytot_rz_diff = temp_diff + bref_diff = bref_diff - cytot_rz*temp_diff/bref + temp_diff = 2.0*cytot_ry_diff/cref + cytot_ry_diff = temp_diff + cref_diff = cref_diff - cytot_ry*temp_diff/cref + temp_diff = 2.0*cytot_rx_diff/bref + cytot_rx_diff = temp_diff + bref_diff = bref_diff - cytot_rx*temp_diff/bref + temp_diff = 2.0*cltot_rz_diff/bref + cltot_rz_diff = temp_diff + bref_diff = bref_diff - cltot_rz*temp_diff/bref + temp_diff = 2.0*cltot_ry_diff/cref + cltot_ry_diff = temp_diff + cref_diff = cref_diff - cltot_ry*temp_diff/cref + temp_diff = 2.0*cltot_rx_diff/bref + cltot_rx_diff = temp_diff + bref_diff = bref_diff - cltot_rx*temp_diff/bref cntot_be_diff = dir*cntot_be_diff cntot_al_diff = dir*cntot_al_diff crtot_be_diff = dir*crtot_be_diff @@ -672,9 +671,9 @@ SUBROUTINE CALC_STAB_DERIVS_B() C C ======================== res and Adjoint for GAM ======== SUBROUTINE GET_RES_B() -C use avl_heap_inc use avl_heap_diff_inc +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER i, ic @@ -686,15 +685,16 @@ SUBROUTINE GET_RES_B() INTEGER l INTEGER iu INTEGER ii1 + INTEGER*4 branch INTEGER ii2 INTEGER ii3 - CALL SET_PAR_AND_CONS(nitmax, irun) C Do not use this routine in the sovler C IF(.NOT.LAIC) THEN C CALL build_AIC C end if + CALL SET_PAR_AND_CONS(nitmax, irun) C--- -c CALL PUSHREAL8ARRAY(wc_gam, 3*nvmax**2) wc_gam is unchanged + CALL PUSHREAL8ARRAY(wc_gam, avl_real*3*nvmax**2/8) c CALL BUILD_AIC() no need to build the AIC again because we assume analysis is run before amach = mach betm = SQRT(1.0 - amach**2) @@ -708,6 +708,14 @@ SUBROUTINE GET_RES_B() C C---- set VINF() vector from initial ALFA,BETA CALL VINFAB() + DO ic=1,ncontrol +C------ don't bother if this control variable is undefined + IF (lcondef(ic)) THEN + CALL PUSHCONTROL1B(1) + ELSE + CALL PUSHCONTROL1B(0) + END IF + ENDDO DO ii1=1,nvor DO ii2=1,nvor aicn_diff(ii2, ii1) = 0.D0 @@ -730,12 +738,10 @@ SUBROUTINE GET_RES_B() DO ii1=1,nvor rhs_d_diff(ii1) = 0.D0 ENDDO -C$BWD-OF II-LOOP - DO ic=1,ncontrol -C------ don't bother if this control variable is undefined - IF (lcondef(ic)) THEN -C$BWD-OF II-LOOP - DO i=1,nvor + DO ic=ncontrol,1,-1 + CALL POPCONTROL1B(branch) + IF (branch .NE. 0) THEN + DO i=nvor,1,-1 rhs_d_diff(i) = rhs_d_diff(i) - res_d_diff(i, ic) ENDDO CALL SET_GAM_D_RHS_B(ic, enc_d, enc_d_diff, rhs_d, rhs_d_diff) @@ -749,8 +755,7 @@ SUBROUTINE GET_RES_B() DO ii1=1,nvor rhs_diff(ii1) = 0.D0 ENDDO -C$BWD-OF II-LOOP - DO i=1,nvor + DO i=nvor,1,-1 rhs_diff(i) = rhs_diff(i) - res_diff(i) ENDDO CALL MAT_PROD_B(aicn, aicn_diff, gam, gam_diff, nvor, res, @@ -812,7 +817,7 @@ SUBROUTINE GET_RES_B() amach_diff = -(2*amach*betm_diff/(2.0*SQRT(1.0-amach**2))) END IF mach_diff = mach_diff + amach_diff -c CALL POPREAL8ARRAY(wc_gam, 3*nvmax**2) wc_gam unchaged + CALL POPREAL8ARRAY(wc_gam, avl_real*3*nvmax**2/8) CALL BUILD_AIC_B() CALL SET_PAR_AND_CONS_B(nitmax, irun) mach_diff = 0.D0 diff --git a/src/ad_src/reverse_ad_src/asetup_b.f b/src/ad_src/reverse_ad_src/asetup_b.f index 82e5956..dfd4d95 100644 --- a/src/ad_src/reverse_ad_src/asetup_b.f +++ b/src/ad_src/reverse_ad_src/asetup_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of build_aic in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: aicn ysym zsym mach rv1 rv2 @@ -12,6 +12,7 @@ SUBROUTINE BUILD_AIC_B() use avl_heap_inc use avl_heap_diff_inc +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' REAL betm @@ -109,6 +110,7 @@ SUBROUTINE BUILD_AIC_B() SUBROUTINE VELSUM_B() use avl_heap_inc use avl_heap_diff_inc +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER i @@ -204,7 +206,7 @@ SUBROUTINE SET_PAR_AND_CONS_B(niter, ir) C INTEGER ii2 INTEGER ii1 - INTEGER branch + INTEGER*4 branch IF (niter .GT. 0) THEN C----- might as well directly set operating variables if they are known IF (icon(ivalfa, ir) .EQ. icalfa) THEN @@ -304,7 +306,6 @@ SUBROUTINE SET_PAR_AND_CONS_B(niter, ir) C with respect to varying inputs: vinf wrot delcon xyzref rc C enc enc_d wcsrd_u SUBROUTINE SET_VEL_RHS_B() -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' REAL rrot(3), vunit(3), vunit_w_term(3), wunit(3) @@ -315,7 +316,7 @@ SUBROUTINE SET_VEL_RHS_B() INTEGER n REAL result1 REAL result1_diff - INTEGER branch + INTEGER*4 branch enc_diff = 0.D0 vunit_diff = 0.D0 wunit_diff = 0.D0 @@ -467,7 +468,7 @@ SUBROUTINE SET_VEL_RHS_U_B(iu) INTEGER n REAL result1 REAL result1_diff - INTEGER branch + INTEGER*4 branch INTEGER iu vunit_diff = 0.D0 vunit_w_term_diff = 0.D0 @@ -565,7 +566,7 @@ SUBROUTINE SET_GAM_D_RHS_B(iq, enc_q, enc_q_diff, rhs_vec, REAL DOT REAL result1 REAL result1_diff - INTEGER branch + INTEGER*4 branch INTEGER ii1 INTEGER iq DO ii1=1,3 diff --git a/src/ad_src/reverse_ad_src/atpforc_b.f b/src/ad_src/reverse_ad_src/atpforc_b.f index ca46786..4083632 100644 --- a/src/ad_src/reverse_ad_src/atpforc_b.f +++ b/src/ad_src/reverse_ad_src/atpforc_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of tpforc in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: bref clff cyff cdff spanef @@ -94,12 +94,12 @@ SUBROUTINE TPFORC_B() REAL temp_diff REAL temp_diff0 REAL temp_diff1 - REAL(kind=8) temp2 - REAL(kind=8) temp_diff2 - REAL(kind=8) temp_diff3 + REAL(kind=avl_real) temp2 + REAL(kind=avl_real) temp_diff2 + REAL(kind=avl_real) temp_diff3 INTEGER ad_from INTEGER ad_to - INTEGER branch + INTEGER*4 branch INTEGER ii1 INTEGER ii2 C @@ -131,7 +131,6 @@ SUBROUTINE TPFORC_B() CALL PUSHINTEGER4(i - 1) CALL PUSHINTEGER4(ad_from) ENDDO -Ccc ENDIF C C---- set x,y,z in wind axes (Y,Z are then in Trefftz plane) DO jc=1,nstrip diff --git a/src/ad_src/reverse_ad_src/cdcl_b.f b/src/ad_src/reverse_ad_src/cdcl_b.f index 453e6da..9168d5d 100644 --- a/src/ad_src/reverse_ad_src/cdcl_b.f +++ b/src/ad_src/reverse_ad_src/cdcl_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of cdcl in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: cd_cl cd diff --git a/src/ad_src/reverse_ad_src/sgutil_b.f b/src/ad_src/reverse_ad_src/sgutil_b.f index 0ba8a1b..25abf5c 100644 --- a/src/ad_src/reverse_ad_src/sgutil_b.f +++ b/src/ad_src/reverse_ad_src/sgutil_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 +C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 C C Differentiation of akima in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: x y xx yy @@ -123,7 +123,7 @@ SUBROUTINE AKIMA_B(x, x_diff, y, y_diff, n, xx, xx_diff, yy, INTEGER ii1 INTEGER ad_count INTEGER i0 - INTEGER branch + INTEGER*4 branch REAL xx REAL xx_diff REAL yy @@ -391,6 +391,24 @@ SUBROUTINE AKIMA_B(x, x_diff, y, y_diff, n, xx, xx_diff, yy, C C C +C This is a extremely important funciton that is not +C documented for some reason. +C Inputs: +C NVC: NUMBER OF DESIRED POINTS IN ARRAY +C CSPACE: SPACING PARAMETER (-3<=PSPACE<=3). +C DEFINES POINT DISTRIBUTION +C TO BE USED AS FOLLOWS: +C PSPACE = 0 : EQUAL SPACING +C PSPACE = 1 : COSINE SPACING. +C PSPACE = 2 : SINE SPACING +C (CONCENTRATING POINTS NEAR 0). +C PSPACE = 3 : EQUAL SPACING. +C CLAF: CL alfa (needed to determine control point location) +C Outputs: +C XPT: Array of panel leading edge x-locations +C XVR: Array of vortex x-locations +C XSR: Array of source x-locations +C XCP: Array of control point x-locations SUBROUTINE CSPACER_B(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, + xcp, xcp_diff) REAL xpt(*), xvr(*), xsr(*), xcp(*) @@ -429,7 +447,7 @@ SUBROUTINE CSPACER_B(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, REAL xcp2 REAL xcp2_diff INTRINSIC SIN - INTEGER branch + INTEGER*4 branch REAL claf REAL claf_diff REAL cspace @@ -442,6 +460,8 @@ SUBROUTINE CSPACER_B(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, acsp = -cspace END IF ncsp = INT(acsp) +C Each of these provides a quarter panel chord offset for cosine, +C sine, and uniform spacing respectively. IF (ncsp .EQ. 0) THEN CALL PUSHCONTROL1B(0) f0 = 1.0 - acsp @@ -466,6 +486,12 @@ SUBROUTINE CSPACER_B(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, C DO ivc=1,nvc C------ uniform +C eqv (IVC-1)/NVC +C quarter-chord +C half-chord +C quarter-chord + half-chord*claf +C Note: claf is a scaling factor so typically claf = 1 and the control point +C is at the three-quarter chord position of the panel C C------ cosine CALL PUSHREAL8(th1) diff --git a/src/build/Makefile b/src/build/Makefile index c3c0e1c..6a72ab0 100644 --- a/src/build/Makefile +++ b/src/build/Makefile @@ -38,7 +38,7 @@ OFILES=$(f90FilesNoDir:%.f90=%.o) $(f77FilesNoDir:%.f=%.o) $(cFilesNoDir:%.c=%.o default: lib ../f2py/libavl.pyf # Generate Python inlude directory - $(eval PYTHON_INCLUDES = $(shell python-config --includes)) + $(eval PYTHON_INCLUDES = $(shell python3-config --includes)) @echo "#------------------------------------------------------#" @echo Python Inclue Flags $(PYTHON_INCLUDES) @echo "#------------------------------------------------------#" From df7b9c39db39ff46c955e463c70c9b04834c2ca5 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 10 Feb 2026 18:46:38 -0500 Subject: [PATCH 42/49] started implementing AD seed routines for meshes in python --- optvl/optvl_class.py | 51 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 7cf78a3..05f24f9 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -416,6 +416,7 @@ def __init__( def _init_map_data(self): """Used in the __init__ method to allocate the slice data for the surfaces""" self.surf_geom_to_fort_var = {} + self.surf_mesh_to_fort_var = {} self.surf_section_geom_to_fort_var = {} self.surf_pannel_to_fort_var = {} self.con_surf_to_fort_var = {} @@ -499,6 +500,15 @@ def _setup_surface_maps(self, surf_name: str, idx_surf: int, num_sec: int): "load": ["SURF_L", "LFLOAD", slice_idx_surf], } + if self.get_avl_fort_arr("SURF_MESH_L", "LSURFMSH", slicer=slice_idx_surf): + nvc = self.get_avl_fort_arr("SURF_GEOM_I", "NVC", slicer=slice_idx_surf) + nvs = self.get_avl_fort_arr("SURF_GEOM_I", "NVS", slicer=slice_idx_surf) + mesh_size = ((nvc+1)*(nvs+1)) + slice_mesh_surf = (slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+mesh_size),slice(None)) + self.surf_mesh_to_fort_var[surf_name] = { + "mesh": ["SURF_MESH_R", "MSHBLK", slice_mesh_surf] + } + icontd_slices = [] idestd_slices = [] xhinged_slices = [] @@ -3474,6 +3484,35 @@ def set_geom_ad_seeds(self, geom_seeds: Dict[str, float], mode: str = "AD", scal # print(blk, var, val, slicer) self.set_avl_fort_arr(blk, var, val, slicer=slicer) + def get_mesh_seeds(self) -> Dict[str, Dict[str, float]]: + mesh_seeds = {} + for surf_key in self.unique_surface_names: + mesh_seeds[surf_key] = {} + for mesh_key in self.surf_mesh_to_fort_var[surf_key]: + blk, var, slicer = self.surf_mesh_to_fort_var[surf_key][mesh_key] + + blk += self.ad_suffix + var += self.ad_suffix + + mesh_seeds[surf_key][mesh_key] = copy.deepcopy(self.get_avl_fort_arr(blk, var, slicer=slicer)) + + return mesh_seeds + + def set_mesh_seeds(self, mesh_seeds: Dict[str, float], mode: str = "AD", scale=1.0) -> None: + for surf_key in mesh_seeds: + for mesh_key in mesh_seeds[surf_key]: + blk, var, slicer = self.surf_mesh_to_fort_var[surf_key][mesh_key] + + if mode == "AD": + blk += self.ad_suffix + var += self.ad_suffix + val = mesh_seeds[surf_key][mesh_key] * scale + elif mode == "FD": + val = self.get_avl_fort_arr(blk, var, slicer=slicer) + val += mesh_seeds[surf_key][mesh_key] * scale + # print(blk, var, val, slicer) + self.set_avl_fort_arr(blk, var, val, slicer=slicer) + # --- state ad seeds --- def get_gamma_ad_seeds(self) -> np.ndarray: slicer = (slice(0, self.get_mesh_size()),) @@ -3712,6 +3751,15 @@ def clear_ad_seeds_fast(self): num_airfoil_pts_max = self.get_avl_fort_arr("SURF_GEOM_R", "XLASEC").shape[-1] num_airfoil_pts = np.max(self.get_avl_fort_arr("SURF_GEOM_I", "NASEC")) + mesh_size_max = 4*num_vor_max + mesh_surf = np.trim_zeros(self.get_avl_fort_arr("SURF_MESH_L", "LSURFMSH")) + mesh_size = 0 + for i, is_mesh in enumerate(mesh_surf): + if is_mesh == 1: + nvc = self.get_avl_fort_arr("SURF_GEOM_I", "NVC", slicer=i) + nvs = self.get_avl_fort_arr("SURF_GEOM_I", "NVS", slicer=i) + mesh_size += (nvc+1)*(nvs+1) + # import psutil # process = psutil.Process() # mem_before = process.memory_info().rss @@ -3743,6 +3791,9 @@ def clear_ad_seeds_fast(self): if dim_size == num_airfoil_pts_max: dim_size = num_airfoil_pts + if dim_size == mesh_size_max: + dim_size = mesh_size + slices.append(slice(0, dim_size)) slicer = tuple(slices) val[slicer] = 0.0 From 86a1b37bcfeae262bc43df6ada0a40e049fe3548 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Tue, 17 Feb 2026 11:04:44 -0500 Subject: [PATCH 43/49] Implemented adjoint. reverse still seg faulting for now with unmodfied aoper_b.f --- optvl/optvl_class.py | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 05f24f9..cc81b93 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -3484,7 +3484,7 @@ def set_geom_ad_seeds(self, geom_seeds: Dict[str, float], mode: str = "AD", scal # print(blk, var, val, slicer) self.set_avl_fort_arr(blk, var, val, slicer=slicer) - def get_mesh_seeds(self) -> Dict[str, Dict[str, float]]: + def get_mesh_ad_seeds(self) -> Dict[str, Dict[str, float]]: mesh_seeds = {} for surf_key in self.unique_surface_names: mesh_seeds[surf_key] = {} @@ -3498,7 +3498,7 @@ def get_mesh_seeds(self) -> Dict[str, Dict[str, float]]: return mesh_seeds - def set_mesh_seeds(self, mesh_seeds: Dict[str, float], mode: str = "AD", scale=1.0) -> None: + def set_mesh_ad_seeds(self, mesh_seeds: Dict[str, float], mode: str = "AD", scale=1.0) -> None: for surf_key in mesh_seeds: for mesh_key in mesh_seeds[surf_key]: blk, var, slicer = self.surf_mesh_to_fort_var[surf_key][mesh_key] @@ -3822,6 +3822,7 @@ def _execute_jac_vec_prod_fwd( self, con_seeds: Optional[Dict[str, float]] = None, geom_seeds: Optional[Dict[str, Dict[str, any]]] = None, + mesh_seeds: Optional[Dict[str, Dict[str, np.ndarray]]] = None, param_seeds: Optional[Dict[str, float]] = None, ref_seeds: Optional[Dict[str, float]] = None, gamma_seeds: Optional[np.ndarray] = None, @@ -3835,6 +3836,7 @@ def _execute_jac_vec_prod_fwd( Args: con_seeds: Case constraint AD seeds geom_seeds: Geometric AD seeds in the same format as the geometric data + mesh_seeds: Mesh geometry AD seeds in the same format as the mesh data param_seeds: Case parameter AD seeds ref_seeds: Reference condition AD seeds gamma_seeds: Circulation AD seeds @@ -3865,6 +3867,9 @@ def _execute_jac_vec_prod_fwd( if geom_seeds is None: geom_seeds = {} + if mesh_seeds is None: + mesh_seeds = {} + if gamma_seeds is None: gamma_seeds = np.zeros(mesh_size) @@ -3889,6 +3894,7 @@ def _execute_jac_vec_prod_fwd( # self.clear_ad_seeds() self.set_variable_ad_seeds(con_seeds) self.set_geom_ad_seeds(geom_seeds) + self.set_mesh_ad_seeds(mesh_seeds) self.set_gamma_ad_seeds(gamma_seeds) self.set_gamma_d_ad_seeds(gamma_d_seeds) self.set_gamma_u_ad_seeds(gamma_u_seeds) @@ -3911,6 +3917,7 @@ def _execute_jac_vec_prod_fwd( self.set_variable_ad_seeds(con_seeds, scale=0.0) self.set_geom_ad_seeds(geom_seeds, scale=0.0) + self.set_mesh_ad_seeds(mesh_seeds, scale=0.0) self.set_gamma_ad_seeds(gamma_seeds, scale=0.0) self.set_gamma_d_ad_seeds(gamma_d_seeds, scale=0.0) self.set_gamma_u_ad_seeds(gamma_u_seeds, scale=0.0) @@ -3923,6 +3930,7 @@ def _execute_jac_vec_prod_fwd( if mode == "FD": self.set_variable_ad_seeds(con_seeds, mode="FD", scale=step) self.set_geom_ad_seeds(geom_seeds, mode="FD", scale=step) + self.set_mesh_ad_seeds(mesh_seeds, mode="FD", scale=step) self.set_gamma_ad_seeds(gamma_seeds, mode="FD", scale=step) self.set_gamma_d_ad_seeds(gamma_d_seeds, mode="FD", scale=step) self.set_gamma_u_ad_seeds(gamma_u_seeds, mode="FD", scale=step) @@ -3946,6 +3954,7 @@ def _execute_jac_vec_prod_fwd( self.set_variable_ad_seeds(con_seeds, mode="FD", scale=-1 * step) self.set_geom_ad_seeds(geom_seeds, mode="FD", scale=-1 * step) + self.set_mesh_ad_seeds(mesh_seeds, mode="FD", scale=-1 * step) self.set_gamma_ad_seeds(gamma_seeds, mode="FD", scale=-1 * step) self.set_gamma_d_ad_seeds(gamma_d_seeds, mode="FD", scale=-1 * step) self.set_gamma_u_ad_seeds(gamma_u_seeds, mode="FD", scale=-1 * step) @@ -4106,6 +4115,7 @@ def _execute_jac_vec_prod_rev( # extract derivatives seeds and set the output dict of functions con_seeds = self.get_variable_ad_seeds() geom_seeds = self.get_geom_ad_seeds() + mesh_seeds = self.get_mesh_ad_seeds() gamma_seeds = self.get_gamma_ad_seeds() gamma_d_seeds = self.get_gamma_d_ad_seeds() gamma_u_seeds = self.get_gamma_u_ad_seeds() @@ -4129,7 +4139,7 @@ def _execute_jac_vec_prod_rev( if print_timings: print(f" Total Time: {time.time() - time_start}") - return con_seeds, geom_seeds, gamma_seeds, gamma_d_seeds, gamma_u_seeds, param_seeds, ref_seeds + return con_seeds, geom_seeds, mesh_seeds, gamma_seeds, gamma_d_seeds, gamma_u_seeds, param_seeds, ref_seeds def execute_run_sensitivities( self, @@ -4163,7 +4173,7 @@ def execute_run_sensitivities( # TODO: remove seeds if it doesn't effect accuracy # self.clear_ad_seeds() time_last = time.time() - _, _, pfpU, _, _, _, _ = self._execute_jac_vec_prod_rev(func_seeds={func: 1.0}) + _, _, _, pfpU, _, _, _, _ = self._execute_jac_vec_prod_rev(func_seeds={func: 1.0}) if print_timings: print(f"Time to get RHS: {time.time() - time_last}") time_last = time.time() @@ -4180,7 +4190,7 @@ def execute_run_sensitivities( # get the resulting adjoint vector (dfunc/dRes) from fortran dfdR = self.get_residual_ad_seeds() # self.clear_ad_seeds() - con_seeds, geom_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( + con_seeds, geom_seeds, mesh_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( func_seeds={func: 1.0}, res_seeds=dfdR ) if print_timings: @@ -4189,6 +4199,7 @@ def execute_run_sensitivities( sens[func].update(con_seeds) sens[func].update(geom_seeds) + sens[func].update(mesh_seeds) sens[func].update(param_seeds) sens[func].update(ref_seeds) @@ -4203,7 +4214,7 @@ def execute_run_sensitivities( # get the RHS of the adjoint equation (pFpU) # TODO: remove seeds if it doesn't effect accuracy - _, _, pfpU, pf_pU_d, _, _, _ = self._execute_jac_vec_prod_rev(consurf_derivs_seeds={func_key: 1.0}) + _, _, _, pfpU, pf_pU_d, _, _, _ = self._execute_jac_vec_prod_rev(consurf_derivs_seeds={func_key: 1.0}) if print_timings: print(f"Time to get RHS: {time.time() - time_last}") time_last = time.time() @@ -4223,7 +4234,7 @@ def execute_run_sensitivities( dfdR = self.get_residual_ad_seeds() dfdR_d = self.get_residual_d_ad_seeds() # self.clear_ad_seeds() - con_seeds, geom_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( + con_seeds, geom_seeds, mesh_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( consurf_derivs_seeds={func_key: 1.0}, res_seeds=dfdR, res_d_seeds=dfdR_d ) if print_timings: @@ -4232,6 +4243,7 @@ def execute_run_sensitivities( sens[func_key].update(con_seeds) sens[func_key].update(geom_seeds) + sens[func_key].update(mesh_seeds) sens[func_key].update(param_seeds) sens[func_key].update(ref_seeds) @@ -4246,7 +4258,7 @@ def execute_run_sensitivities( # get the RHS of the adjoint equation (pFpU) # TODO: remove seeds if it doesn't effect accuracy - _, _, pfpU, _, pf_pU_u, _, _ = self._execute_jac_vec_prod_rev(stab_derivs_seeds={func_key: 1.0}) + _, _, _, pfpU, _, pf_pU_u, _, _ = self._execute_jac_vec_prod_rev(stab_derivs_seeds={func_key: 1.0}) if print_timings: print(f"Time to get RHS: {time.time() - time_last}") time_last = time.time() @@ -4266,7 +4278,7 @@ def execute_run_sensitivities( dfdR = self.get_residual_ad_seeds() dfdR_u = self.get_residual_u_ad_seeds() # self.clear_ad_seeds() - con_seeds, geom_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( + con_seeds, geom_seeds, mesh_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( stab_derivs_seeds={func_key: 1.0}, res_seeds=dfdR, res_u_seeds=dfdR_u ) @@ -4276,6 +4288,7 @@ def execute_run_sensitivities( sens[func_key].update(con_seeds) sens[func_key].update(geom_seeds) + sens[func_key].update(mesh_seeds) sens[func_key].update(param_seeds) sens[func_key].update(ref_seeds) # sd_deriv_seeds[func_key] = 0.0 @@ -4291,7 +4304,7 @@ def execute_run_sensitivities( # get the RHS of the adjoint equation (pFpU) # TODO: remove seeds if it doesn't effect accuracy - _, _, pfpU, _, pf_pU_u, _, _ = self._execute_jac_vec_prod_rev(body_axis_derivs_seeds={func_key: 1.0}) + _, _, _, pfpU, _, pf_pU_u, _, _ = self._execute_jac_vec_prod_rev(body_axis_derivs_seeds={func_key: 1.0}) if print_timings: print(f"Time to get RHS: {time.time() - time_last}") time_last = time.time() @@ -4311,7 +4324,7 @@ def execute_run_sensitivities( dfdR = self.get_residual_ad_seeds() dfdR_u = self.get_residual_u_ad_seeds() # self.clear_ad_seeds() - con_seeds, geom_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( + con_seeds, geom_seeds, mesh_seeds, _, _, _, param_seeds, ref_seeds = self._execute_jac_vec_prod_rev( body_axis_derivs_seeds={func_key: 1.0}, res_seeds=dfdR, res_u_seeds=dfdR_u ) @@ -4321,6 +4334,7 @@ def execute_run_sensitivities( sens[func_key].update(con_seeds) sens[func_key].update(geom_seeds) + sens[func_key].update(mesh_seeds) sens[func_key].update(param_seeds) sens[func_key].update(ref_seeds) From c63cdde6b10fa212da9fd35e713cc561cdb29c2b Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 23 Feb 2026 14:47:33 -0500 Subject: [PATCH 44/49] redo tapenade --- optvl/optvl_class.py | 29 +- src/ad_src/Makefile_tapenade | 2 +- src/ad_src/forward_ad_src/aero_d.f | 149 +++++----- src/ad_src/forward_ad_src/aic_d.f | 45 ++- src/ad_src/forward_ad_src/amake_d.f | 354 +++++++++++----------- src/ad_src/forward_ad_src/amode_d.f | 4 +- src/ad_src/forward_ad_src/aoper_d.f | 16 +- src/ad_src/forward_ad_src/asetup_d.f | 10 +- src/ad_src/forward_ad_src/atpforc_d.f | 121 ++++---- src/ad_src/forward_ad_src/cdcl_d.f | 2 +- src/ad_src/forward_ad_src/sgutil_d.f | 4 +- src/ad_src/reverse_ad_src/aero_b.f | 359 ++++++++++++++--------- src/ad_src/reverse_ad_src/aic_b.f | 152 +++++----- src/ad_src/reverse_ad_src/amake_b.f | 305 ++++++++++--------- src/ad_src/reverse_ad_src/amode_b.f | 4 +- src/ad_src/reverse_ad_src/aoper_b.f | 267 +++++++++-------- src/ad_src/reverse_ad_src/asetup_b.f | 13 +- src/ad_src/reverse_ad_src/atpforc_b.f | 11 +- src/ad_src/reverse_ad_src/cdcl_b.f | 2 +- src/ad_src/reverse_ad_src/sgutil_b.f | 6 +- tests/test_partial_derivs.py | 10 +- tests/test_stab_derivs_partial_derivs.py | 6 +- tests/test_total_derivs.py | 1 + 23 files changed, 978 insertions(+), 894 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index cc81b93..6faf645 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -403,6 +403,11 @@ def __init__( deriv_key = self._get_deriv_key(var, func) self.case_body_derivs_to_fort_var[deriv_key] = ["CASE_R", f"{func_to_prefix[func]}TOT_U_BA", idx_var] + # In the case where there is no mesh then we have to initialize these before _init_map_data so ad seeds work correclty + if not input_dict or ("mesh" not in input_dict.keys()): + self.mesh_idx_first = np.zeros(self.get_num_surfaces(),dtype=np.int32) + self.y_offsets = np.zeros(self.get_num_surfaces(),dtype=np.float64) + # the case parameters are stored in a 1d array, # these indices correspond to the position of each parameter in that arra self._init_map_data() @@ -500,14 +505,15 @@ def _setup_surface_maps(self, surf_name: str, idx_surf: int, num_sec: int): "load": ["SURF_L", "LFLOAD", slice_idx_surf], } - if self.get_avl_fort_arr("SURF_MESH_L", "LSURFMSH", slicer=slice_idx_surf): - nvc = self.get_avl_fort_arr("SURF_GEOM_I", "NVC", slicer=slice_idx_surf) - nvs = self.get_avl_fort_arr("SURF_GEOM_I", "NVS", slicer=slice_idx_surf) - mesh_size = ((nvc+1)*(nvs+1)) - slice_mesh_surf = (slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+mesh_size),slice(None)) - self.surf_mesh_to_fort_var[surf_name] = { - "mesh": ["SURF_MESH_R", "MSHBLK", slice_mesh_surf] - } + # We need this map to be setup regardless of if we have a mesh so that the ad routines work correctly + # if self.get_avl_fort_arr("SURF_MESH_L", "LSURFMSH", slicer=slice_idx_surf): + nvc = self.get_avl_fort_arr("SURF_GEOM_I", "NVC", slicer=slice_idx_surf) + nvs = self.get_avl_fort_arr("SURF_GEOM_I", "NVS", slicer=slice_idx_surf) + mesh_size = ((nvc+1)*(nvs+1)) + slice_mesh_surf = (slice(self.mesh_idx_first[idx_surf],self.mesh_idx_first[idx_surf]+mesh_size),slice(None)) + self.surf_mesh_to_fort_var[surf_name] = { + "mesh": ["SURF_MESH_R", "MSHBLK", slice_mesh_surf] + } icontd_slices = [] idestd_slices = [] @@ -789,6 +795,7 @@ def check_type(key, avl_vars, given_val, cast_type=True): # setup surface data for initial input self.surf_geom_to_fort_var = {} self.surf_section_geom_to_fort_var = {} + self.surf_mesh_to_fort_var = {} self.surf_pannel_to_fort_var = {} self.con_surf_to_fort_var = {} self.des_var_to_fort_var = {} @@ -4198,8 +4205,10 @@ def execute_run_sensitivities( time_last = time.time() sens[func].update(con_seeds) - sens[func].update(geom_seeds) - sens[func].update(mesh_seeds) + # I don't know if it's worth combining geom_seeds and mesh_seeds into one just to make this one part less nasty + for key in geom_seeds: + sens[func][key] = geom_seeds[key] | mesh_seeds[key] + # sens[func].update(mesh_seeds) sens[func].update(param_seeds) sens[func].update(ref_seeds) diff --git a/src/ad_src/Makefile_tapenade b/src/ad_src/Makefile_tapenade index f4f386b..908cfea 100644 --- a/src/ad_src/Makefile_tapenade +++ b/src/ad_src/Makefile_tapenade @@ -103,7 +103,7 @@ ad_forward: preprocess_files clean_fwd python ad_utils/edit_ad_src.py forward --input=forward_tmp --output=forward_ad_src -ad_reverse: preprocess_files clean_rev +ad_reverse: preprocess_files # The following is the single Tapenade command to run: $(TAPENADE_HOME)/bin/tapenade \ diff --git a/src/ad_src/forward_ad_src/aero_d.f b/src/ad_src/forward_ad_src/aero_d.f index 94e3586..718de70 100644 --- a/src/ad_src/forward_ad_src/aero_d.f +++ b/src/ad_src/forward_ad_src/aero_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of aero in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: clff cyff cdff spanef cdtot @@ -85,7 +85,7 @@ SUBROUTINE AERO_D() EXTERNAL GETSA INTEGER is REAL temp - REAL(kind=avl_real) temp0 + REAL(kind=8) temp0 REAL(kind=avl_real) temp1 C cdtot = 0. @@ -321,8 +321,8 @@ SUBROUTINE AERO_D() cmsurfbax(1, is) = dir*cmsurf(1, is) cmsurfbax(2, is) = cmsurf(2, is) cmsurfbax(3, is) = dir*cmsurf(3, is) -C compute the stability derivatives every time (it's quite cheap) ENDDO +C compute the stability derivatives every time (it's quite cheap) C C CALL CALC_STAB_DERIVS_D() @@ -488,7 +488,7 @@ SUBROUTINE SFFORC_D() REAL temp INTEGER ii1 REAL temp0 - REAL(kind=avl_real) temp1 + REAL(kind=8) temp1 INTEGER ii2 INTEGER ii3 DATA icrs /2, 3, 1/ @@ -812,13 +812,6 @@ SUBROUTINE SFFORC_D() + ulmag ulift_u(k, n) = temp ENDDO -C write(6,*) 'Strip J ',J -C write(6,*) 'UDRAG ',UDRAG -C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG -C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) -C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) -C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) - ENDDO END IF C @@ -2285,8 +2278,8 @@ SUBROUTINE SFFORC_D() cf_lsrf(l, is) = 0.0 cm_lsrf(l, is) = 0.0 enave(l) = 0.0 -C NSTRPS = NJ(IS) ENDDO +C NSTRPS = NJ(IS) C DO jj=1,nj(is) j = jfrst(is) + jj - 1 @@ -2615,6 +2608,12 @@ SUBROUTINE SFFORC_D() C C RETURN +C write(6,*) 'Strip J ',J +C write(6,*) 'UDRAG ',UDRAG +C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG +C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) +C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) +C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) 3 FORMAT(a,6(2x,f8.5)) END @@ -2675,12 +2674,13 @@ SUBROUTINE BDFORC_D() REAL un_u_diff REAL dir EXTERNAL GETSA - REAL(kind=avl_real) arg1 - REAL(kind=avl_real) arg1_diff + REAL(kind=8) arg1 + REAL(kind=8) arg1_diff REAL arg10 REAL arg10_diff REAL(kind=avl_real) temp - REAL temp0 + REAL(kind=8) temp0 + REAL temp1 INTEGER ii1 INTEGER ii2 C @@ -2777,6 +2777,7 @@ SUBROUTINE BDFORC_D() DO ii1=1,3 rrot_diff(ii1) = 0.D0 ENDDO +C compute the forces on the body in the body axis C C C---- add on body force contributions @@ -2815,9 +2816,9 @@ SUBROUTINE BDFORC_D() C l = l1 C - temp = (rl(1, l2)-rl(1, l1))/betm - drl_diff(1) = -(temp*betm_diff/betm) - drl(1) = temp + temp0 = (rl(1, l2)-rl(1, l1))/betm + drl_diff(1) = -(temp0*betm_diff/betm) + drl(1) = temp0 drl_diff(2) = 0.D0 drl(2) = rl(2, l2) - rl(2, l1) drl_diff(3) = 0.D0 @@ -2825,13 +2826,13 @@ SUBROUTINE BDFORC_D() arg10_diff = 2*drl(1)*drl_diff(1) + 2*drl(2)*drl_diff(2) + 2* + drl(3)*drl_diff(3) arg10 = drl(1)**2 + drl(2)**2 + drl(3)**2 - temp0 = SQRT(arg10) + temp1 = SQRT(arg10) IF (arg10 .EQ. 0.D0) THEN drlmag_diff = 0.D0 ELSE - drlmag_diff = arg10_diff/(2.0*temp0) + drlmag_diff = arg10_diff/(2.0*temp1) END IF - drlmag = temp0 + drlmag = temp1 IF (drlmag .EQ. 0.0) THEN drlmi = 0.0 drlmi_diff = 0.D0 @@ -2866,9 +2867,10 @@ SUBROUTINE BDFORC_D() CALL CROSS_D(rrot, rrot_diff, wrot, wrot_diff, vrot, vrot_diff + ) C - temp = (vinf(1)+vrot(1))/betm - veff_diff(1) = (vinf_diff(1)+vrot_diff(1)-temp*betm_diff)/betm - veff(1) = temp + temp0 = (vinf(1)+vrot(1))/betm + veff_diff(1) = (vinf_diff(1)+vrot_diff(1)-temp0*betm_diff)/ + + betm + veff(1) = temp0 veff_diff(2) = vinf_diff(2) + vrot_diff(2) veff(2) = vinf(2) + vrot(2) veff_diff(3) = vinf_diff(3) + vrot_diff(3) @@ -2920,14 +2922,14 @@ SUBROUTINE BDFORC_D() fb(k) = un*src(l) C DO iu=1,6 - temp0 = veff_u(1, iu)*esl(1) + veff_u(2, iu)*esl(2) + + temp1 = veff_u(1, iu)*esl(1) + veff_u(2, iu)*esl(2) + + veff_u(3, iu)*esl(3) un_u_diff = veff_u_diff(k, iu) - esl(k)*(esl(1)* + veff_u_diff(1, iu)+veff_u(1, iu)*esl_diff(1)+esl(2)* + veff_u_diff(2, iu)+veff_u(2, iu)*esl_diff(2)+esl(3)* - + veff_u_diff(3, iu)+veff_u(3, iu)*esl_diff(3)) - temp0* + + veff_u_diff(3, iu)+veff_u(3, iu)*esl_diff(3)) - temp1* + esl_diff(k) - un_u = veff_u(k, iu) - temp0*esl(k) + un_u = veff_u(k, iu) - temp1*esl(k) fb_u_diff(k, iu) = src_u(l, iu)*un_diff + un*src_u_diff(l + , iu) + src(l)*un_u_diff + un_u*src_diff(l) fb_u(k, iu) = un*src_u(l, iu) + un_u*src(l) @@ -2942,74 +2944,74 @@ SUBROUTINE BDFORC_D() + , mb_u(:, iu), mb_u_diff(:, iu)) ENDDO C - temp = (fb(1)*cosa+fb(3)*sina)/sref + temp0 = (fb(1)*cosa+fb(3)*sina)/sref cdbdy_diff(ib) = cdbdy_diff(ib) + 2.0*(cosa*fb_diff(1)+fb(1)* - + cosa_diff+sina*fb_diff(3)+fb(3)*sina_diff-temp*sref_diff)/ + + cosa_diff+sina*fb_diff(3)+fb(3)*sina_diff-temp0*sref_diff)/ + sref - cdbdy(ib) = cdbdy(ib) + 2.0*temp - temp = fb(2)/sref - cybdy_diff(ib) = cybdy_diff(ib) + 2.0*(fb_diff(2)-temp* + cdbdy(ib) = cdbdy(ib) + 2.0*temp0 + temp0 = fb(2)/sref + cybdy_diff(ib) = cybdy_diff(ib) + 2.0*(fb_diff(2)-temp0* + sref_diff)/sref - cybdy(ib) = cybdy(ib) + 2.0*temp - temp = (fb(3)*cosa-fb(1)*sina)/sref + cybdy(ib) = cybdy(ib) + 2.0*temp0 + temp0 = (fb(3)*cosa-fb(1)*sina)/sref clbdy_diff(ib) = clbdy_diff(ib) + 2.0*(cosa*fb_diff(3)+fb(3)* - + cosa_diff-sina*fb_diff(1)-fb(1)*sina_diff-temp*sref_diff)/ + + cosa_diff-sina*fb_diff(1)-fb(1)*sina_diff-temp0*sref_diff)/ + sref - clbdy(ib) = clbdy(ib) + 2.0*temp + clbdy(ib) = clbdy(ib) + 2.0*temp0 DO l=1,3 - temp = fb(l)/sref - cfbdy_diff(l, ib) = cfbdy_diff(l, ib) + 2.0*(fb_diff(l)-temp - + *sref_diff)/sref - cfbdy(l, ib) = cfbdy(l, ib) + 2.0*temp + temp0 = fb(l)/sref + cfbdy_diff(l, ib) = cfbdy_diff(l, ib) + 2.0*(fb_diff(l)- + + temp0*sref_diff)/sref + cfbdy(l, ib) = cfbdy(l, ib) + 2.0*temp0 ENDDO - temp = mb(1)/(sref*bref) - cmbdy_diff(1, ib) = cmbdy_diff(1, ib) + 2.0*(mb_diff(1)-temp*( - + bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy(1, ib) = cmbdy(1, ib) + 2.0*temp - temp = mb(2)/(sref*cref) - cmbdy_diff(2, ib) = cmbdy_diff(2, ib) + 2.0*(mb_diff(2)-temp*( - + cref*sref_diff+sref*cref_diff))/(sref*cref) - cmbdy(2, ib) = cmbdy(2, ib) + 2.0*temp - temp = mb(3)/(sref*bref) - cmbdy_diff(3, ib) = cmbdy_diff(3, ib) + 2.0*(mb_diff(3)-temp*( - + bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy(3, ib) = cmbdy(3, ib) + 2.0*temp + temp0 = mb(1)/(sref*bref) + cmbdy_diff(1, ib) = cmbdy_diff(1, ib) + 2.0*(mb_diff(1)-temp0* + + (bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy(1, ib) = cmbdy(1, ib) + 2.0*temp0 + temp0 = mb(2)/(sref*cref) + cmbdy_diff(2, ib) = cmbdy_diff(2, ib) + 2.0*(mb_diff(2)-temp0* + + (cref*sref_diff+sref*cref_diff))/(sref*cref) + cmbdy(2, ib) = cmbdy(2, ib) + 2.0*temp0 + temp0 = mb(3)/(sref*bref) + cmbdy_diff(3, ib) = cmbdy_diff(3, ib) + 2.0*(mb_diff(3)-temp0* + + (bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy(3, ib) = cmbdy(3, ib) + 2.0*temp0 C DO iu=1,6 - temp = (fb_u(1, iu)*cosa+fb_u(3, iu)*sina)/sref + temp0 = (fb_u(1, iu)*cosa+fb_u(3, iu)*sina)/sref cdbdy_u_diff(iu) = cdbdy_u_diff(iu) + 2.0*(cosa*fb_u_diff(1 + , iu)+fb_u(1, iu)*cosa_diff+sina*fb_u_diff(3, iu)+fb_u(3, - + iu)*sina_diff-temp*sref_diff)/sref - cdbdy_u(iu) = cdbdy_u(iu) + 2.0*temp - temp = fb_u(2, iu)/sref + + iu)*sina_diff-temp0*sref_diff)/sref + cdbdy_u(iu) = cdbdy_u(iu) + 2.0*temp0 + temp0 = fb_u(2, iu)/sref cybdy_u_diff(iu) = cybdy_u_diff(iu) + 2.0*(fb_u_diff(2, iu)- - + temp*sref_diff)/sref - cybdy_u(iu) = cybdy_u(iu) + 2.0*temp - temp = (fb_u(3, iu)*cosa-fb_u(1, iu)*sina)/sref + + temp0*sref_diff)/sref + cybdy_u(iu) = cybdy_u(iu) + 2.0*temp0 + temp0 = (fb_u(3, iu)*cosa-fb_u(1, iu)*sina)/sref clbdy_u_diff(iu) = clbdy_u_diff(iu) + 2.0*(cosa*fb_u_diff(3 + , iu)+fb_u(3, iu)*cosa_diff-sina*fb_u_diff(1, iu)-fb_u(1, - + iu)*sina_diff-temp*sref_diff)/sref - clbdy_u(iu) = clbdy_u(iu) + 2.0*temp + + iu)*sina_diff-temp0*sref_diff)/sref + clbdy_u(iu) = clbdy_u(iu) + 2.0*temp0 C DO l=1,3 - temp = fb_u(l, iu)/sref + temp0 = fb_u(l, iu)/sref cfbdy_u_diff(l, iu) = cfbdy_u_diff(l, iu) + 2.0*(fb_u_diff - + (l, iu)-temp*sref_diff)/sref - cfbdy_u(l, iu) = cfbdy_u(l, iu) + 2.0*temp + + (l, iu)-temp0*sref_diff)/sref + cfbdy_u(l, iu) = cfbdy_u(l, iu) + 2.0*temp0 ENDDO C - temp = mb_u(1, iu)/(sref*bref) + temp0 = mb_u(1, iu)/(sref*bref) cmbdy_u_diff(1, iu) = cmbdy_u_diff(1, iu) + 2.0*(mb_u_diff(1 - + , iu)-temp*(bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy_u(1, iu) = cmbdy_u(1, iu) + 2.0*temp - temp = mb_u(2, iu)/(sref*cref) + + , iu)-temp0*(bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy_u(1, iu) = cmbdy_u(1, iu) + 2.0*temp0 + temp0 = mb_u(2, iu)/(sref*cref) cmbdy_u_diff(2, iu) = cmbdy_u_diff(2, iu) + 2.0*(mb_u_diff(2 - + , iu)-temp*(cref*sref_diff+sref*cref_diff))/(sref*cref) - cmbdy_u(2, iu) = cmbdy_u(2, iu) + 2.0*temp - temp = mb_u(3, iu)/(sref*bref) + + , iu)-temp0*(cref*sref_diff+sref*cref_diff))/(sref*cref) + cmbdy_u(2, iu) = cmbdy_u(2, iu) + 2.0*temp0 + temp0 = mb_u(3, iu)/(sref*bref) cmbdy_u_diff(3, iu) = cmbdy_u_diff(3, iu) + 2.0*(mb_u_diff(3 - + , iu)-temp*(bref*sref_diff+sref*bref_diff))/(sref*bref) - cmbdy_u(3, iu) = cmbdy_u(3, iu) + 2.0*temp + + , iu)-temp0*(bref*sref_diff+sref*bref_diff))/(sref*bref) + cmbdy_u(3, iu) = cmbdy_u(3, iu) + 2.0*temp0 ENDDO ENDDO C @@ -3046,7 +3048,6 @@ SUBROUTINE BDFORC_D() ENDDO ENDDO ENDDO -C compute the forces on the body in the body axis C CALL GETSA(lnasa_sa, satype, dir) C diff --git a/src/ad_src/forward_ad_src/aic_d.f b/src/ad_src/forward_ad_src/aic_d.f index 330ee5a..4e78314 100644 --- a/src/ad_src/forward_ad_src/aic_d.f +++ b/src/ad_src/forward_ad_src/aic_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of vvor in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: wc_gam @@ -96,7 +96,6 @@ SUBROUTINE VVOR_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL(kind=avl_real) arg1 REAL(kind=avl_real) arg1_diff REAL(kind=avl_real) temp - REAL(kind=avl_real) temp0 INTEGER ii3 INTEGER ii2 INTEGER ii1 @@ -140,18 +139,17 @@ SUBROUTINE VVOR_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, C DO j=1,nv C--------- set vortex core - temp = rv2(2, j) - rv1(2, j) - temp0 = rv2(3, j) - rv1(3, j) - arg1_diff = 2*temp*(rv2_diff(2, j)-rv1_diff(2, j)) + 2*temp0*( - + rv2_diff(3, j)-rv1_diff(3, j)) - arg1 = temp*temp + temp0*temp0 - temp0 = SQRT(arg1) + arg1_diff = 2*(rv2(2, j)-rv1(2, j))*(rv2_diff(2, j)-rv1_diff(2 + + , j)) + 2*(rv2(3, j)-rv1(3, j))*(rv2_diff(3, j)-rv1_diff(3, + + j)) + arg1 = (rv2(2, j)-rv1(2, j))**2 + (rv2(3, j)-rv1(3, j))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN dsyz_diff = 0.D0 ELSE - dsyz_diff = arg1_diff/(2.0*temp0) + dsyz_diff = arg1_diff/(2.0*temp) END IF - dsyz = temp0 + dsyz = temp C---- default (non-zero) core size based on spanwise lattice spacing rcore_diff = 0.0001*dsyz_diff rcore = 0.0001*dsyz @@ -380,8 +378,6 @@ SUBROUTINE VSRD_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL arg1 REAL arg1_diff REAL temp - REAL temp0 - REAL temp1 INTEGER ii1 INTEGER ii2 INTEGER ii3 @@ -441,20 +437,19 @@ SUBROUTINE VSRD_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, C arg1 = 0.5*(radl(l2)**2+radl(l1)**2) ravg = SQRT(arg1) - temp = rl(1, l2) - rl(1, l1) - temp0 = rl(2, l2) - rl(2, l1) - temp1 = rl(3, l2) - rl(3, l1) - arg1_diff = 2*temp*(rl_diff(1, l2)-rl_diff(1, l1)) + 2*temp0*( - + rl_diff(2, l2)-rl_diff(2, l1)) + 2*temp1*(rl_diff(3, l2)- - + rl_diff(3, l1)) - arg1 = temp*temp + temp0*temp0 + temp1*temp1 - temp1 = SQRT(arg1) + arg1_diff = 2*(rl(1, l2)-rl(1, l1))*(rl_diff(1, l2)-rl_diff(1 + + , l1)) + 2*(rl(2, l2)-rl(2, l1))*(rl_diff(2, l2)-rl_diff(2, + + l1)) + 2*(rl(3, l2)-rl(3, l1))*(rl_diff(3, l2)-rl_diff(3, l1 + + )) + arg1 = (rl(1, l2)-rl(1, l1))**2 + (rl(2, l2)-rl(2, l1))**2 + ( + + rl(3, l2)-rl(3, l1))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN rlavg_diff = 0.D0 ELSE - rlavg_diff = arg1_diff/(2.0*temp1) + rlavg_diff = arg1_diff/(2.0*temp) END IF - rlavg = temp1 + rlavg = temp Ccc print *,'L RAVG, RLAVG ',L,RAVG, RLAVG IF (srcore .GT. 0) THEN rcore = srcore*ravg @@ -570,12 +565,11 @@ SUBROUTINE VSRD_D(betm, betm_diff, iysym, ysym, ysym_diff, izsym, ENDDO END IF END IF -C - ENDDO ENDDO ENDDO C +C C RETURN END @@ -847,10 +841,11 @@ SUBROUTINE CROSS_D(u, u_diff, v, v_diff, w, w_diff) C with respect to varying inputs: u v C C - REAL FUNCTION DOT_D(u, u_diff, v, v_diff, dot) + FUNCTION DOT_D(u, u_diff, v, v_diff, dot) REAL u(3), v(3) REAL u_diff(3), v_diff(3) REAL dot + REAL dot_d dot_d = v(1)*u_diff(1) + u(1)*v_diff(1) + v(2)*u_diff(2) + u(2)* + v_diff(2) + v(3)*u_diff(3) + u(3)*v_diff(3) dot = u(1)*v(1) + u(2)*v(2) + u(3)*v(3) diff --git a/src/ad_src/forward_ad_src/amake_d.f b/src/ad_src/forward_ad_src/amake_d.f index 9ec13ae..17bf2b2 100644 --- a/src/ad_src/forward_ad_src/amake_d.f +++ b/src/ad_src/forward_ad_src/amake_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of update_surfaces in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: rle chord rle1 chord1 rle2 @@ -430,9 +430,9 @@ SUBROUTINE MAKESURF_D(isurf) result1 = temp yzlen_diff(isec) = yzlen_diff(isec-1) + result1_diff yzlen(isec) = yzlen(isec-1) + result1 + ENDDO C we can not rely on the original condition becuase NVS(ISURF) is filled C and we may want to rebuild the surface later - ENDDO C IF (nvs(isurf) .EQ. 0 .OR. (lsurfspacing(isurf) .EQV. .false.)) + THEN @@ -1065,10 +1065,9 @@ SUBROUTINE MAKESURF_D(isurf) phinge(3, idx_strip, n) = rle(3, idx_strip) END IF END IF -C - ENDDO C +C C--- Interpolate CD-CL polar defining data from input sections to strips DO l=1,6 clcd(l, idx_strip) = (1.0-fc)*clcdsec(l, isec, isurf) + @@ -1439,12 +1438,13 @@ SUBROUTINE MAKESURF_MESH_D(isurf) REAL arg1_diff REAL arg2 REAL arg2_diff - REAL(kind=avl_real) arg10 - REAL(kind=avl_real) arg10_diff + REAL(kind=8) arg10 + REAL(kind=8) arg10_diff REAL temp REAL temp0 - REAL(kind=avl_real) temp1 - REAL(kind=avl_real) temp2 + REAL(kind=8) temp1 + REAL(kind=8) temp2 + REAL(kind=avl_real) temp3 C nx = nvc(isurf) + 1 C Check MFRST @@ -1515,8 +1515,8 @@ SUBROUTINE MAKESURF_MESH_D(isurf) DO isec=1,nsec(isurf) ii = icntfrst(isurf) + (isec-1) icntsec(ii) = idx_strip -C Apply the scaling and translations to the mesh as a whole ENDDO +C Apply the scaling and translations to the mesh as a whole C C DO idx_y=1,ny @@ -1531,10 +1531,9 @@ SUBROUTINE MAKESURF_MESH_D(isurf) + mesh_surf(idx_dim, idx_node) + xyztran(idx_dim, isurf) ENDDO ENDDO + ENDDO C Setup the strips C Set spanwise elements to 0 - - ENDDO C C C @@ -1577,34 +1576,36 @@ SUBROUTINE MAKESURF_MESH_D(isurf) C idx_node = FLATIDX(1, iptl, isurf) idx_node_nx = FLATIDX(nx, iptl, isurf) - temp = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) - temp0 = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) - arg1_diff = 2*temp*(mesh_surf_diff(1, idx_node_nx)- - + mesh_surf_diff(1, idx_node)) + 2*temp0*(mesh_surf_diff(3, - + idx_node_nx)-mesh_surf_diff(3, idx_node)) - arg1 = temp*temp + temp0*temp0 - temp0 = SQRT(arg1) + arg1_diff = 2*(mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node + + ))*(mesh_surf_diff(1, idx_node_nx)-mesh_surf_diff(1, + + idx_node)) + 2*(mesh_surf(3, idx_node_nx)-mesh_surf(3, + + idx_node))*(mesh_surf_diff(3, idx_node_nx)-mesh_surf_diff(3 + + , idx_node)) + arg1 = (mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node))**2 + + + (mesh_surf(3, idx_node_nx)-mesh_surf(3, idx_node))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN chordl_diff = 0.D0 ELSE - chordl_diff = arg1_diff/(2.0*temp0) + chordl_diff = arg1_diff/(2.0*temp) END IF - chordl = temp0 + chordl = temp idx_node = FLATIDX(1, iptr, isurf) idx_node_nx = FLATIDX(nx, iptr, isurf) - temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) - temp = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) - arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_nx)- - + mesh_surf_diff(1, idx_node)) + 2*temp*(mesh_surf_diff(3, - + idx_node_nx)-mesh_surf_diff(3, idx_node)) - arg1 = temp0*temp0 + temp*temp - temp0 = SQRT(arg1) + arg1_diff = 2*(mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node + + ))*(mesh_surf_diff(1, idx_node_nx)-mesh_surf_diff(1, + + idx_node)) + 2*(mesh_surf(3, idx_node_nx)-mesh_surf(3, + + idx_node))*(mesh_surf_diff(3, idx_node_nx)-mesh_surf_diff(3 + + , idx_node)) + arg1 = (mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node))**2 + + + (mesh_surf(3, idx_node_nx)-mesh_surf(3, idx_node))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN chordr_diff = 0.D0 ELSE - chordr_diff = arg1_diff/(2.0*temp0) + chordr_diff = arg1_diff/(2.0*temp) END IF - chordr = temp0 + chordr = temp clafl_diff = claf_diff(iptl, isurf) clafl = claf(iptl, isurf) C Linearly interpolate the incidence projections over the STRIP @@ -1617,20 +1618,20 @@ SUBROUTINE MAKESURF_MESH_D(isurf) aincr_diff = dtr*aincs_diff(iptr, isurf) + dtr*addinc_diff( + isurf) aincr = aincs(iptr, isurf)*dtr + addinc(isurf)*dtr - temp0 = SIN(aincl) - chsinl_diff = temp0*chordl_diff + chordl*COS(aincl)*aincl_diff - chsinl = chordl*temp0 - temp0 = SIN(aincr) - chsinr_diff = temp0*chordr_diff + chordr*COS(aincr)*aincr_diff - chsinr = chordr*temp0 - temp0 = COS(aincl) - chcosl_diff = temp0*chordl_diff - chordl*SIN(aincl)*aincl_diff - chcosl = chordl*temp0 + temp = SIN(aincl) + chsinl_diff = temp*chordl_diff + chordl*COS(aincl)*aincl_diff + chsinl = chordl*temp + temp = SIN(aincr) + chsinr_diff = temp*chordr_diff + chordr*COS(aincr)*aincr_diff + chsinr = chordr*temp + temp = COS(aincl) + chcosl_diff = temp*chordl_diff - chordl*SIN(aincl)*aincl_diff + chcosl = chordl*temp C We need to determine which controls belong to this section C Bring over the routine for this from makesurf but do it for each strip now - temp0 = COS(aincr) - chcosr_diff = temp0*chordr_diff - chordr*SIN(aincr)*aincr_diff - chcosr = chordr*temp0 + temp = COS(aincr) + chcosr_diff = temp*chordr_diff - chordr*SIN(aincr)*aincr_diff + chcosr = chordr*temp C DO n=1,ncontrol isconl(n) = 0 @@ -1641,11 +1642,10 @@ SUBROUTINE MAKESURF_MESH_D(isurf) DO iscon=1,nscon(iptr, isurf) IF (icontd(iscon, iptr, isurf) .EQ. n) isconr(n) = iscon ENDDO + ENDDO C We need to determine which dvs belong to this strip C and setup the chord projection gains C Bring over the routine for this from makesurf but setup for strips - - ENDDO C DO n=1,ndesign chsinl_g_diff(n) = 0.D0 @@ -1678,13 +1678,12 @@ SUBROUTINE MAKESURF_MESH_D(isurf) chcosr_g(n) = -(chsinr*gaing(isdes, iptr, isurf)*dtr) END IF ENDDO + ENDDO C Set the strip geometry data C Note these computations assume the mesh is not necessarily planar C ultimately if/when we flatten the mesh into a planar one we will want C to use the leading edge positions and chords from the original input mesh C Strip left side - - ENDDO C C C @@ -1697,19 +1696,20 @@ SUBROUTINE MAKESURF_MESH_D(isurf) ENDDO C C Strip right side - temp0 = mesh_surf(1, idx_node_nx) - mesh_surf(1, idx_node) - temp = mesh_surf(3, idx_node_nx) - mesh_surf(3, idx_node) - arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_nx)- - + mesh_surf_diff(1, idx_node)) + 2*temp*(mesh_surf_diff(3, - + idx_node_nx)-mesh_surf_diff(3, idx_node)) - arg1 = temp0*temp0 + temp*temp - temp0 = SQRT(arg1) + arg1_diff = 2*(mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node + + ))*(mesh_surf_diff(1, idx_node_nx)-mesh_surf_diff(1, + + idx_node)) + 2*(mesh_surf(3, idx_node_nx)-mesh_surf(3, + + idx_node))*(mesh_surf_diff(3, idx_node_nx)-mesh_surf_diff(3 + + , idx_node)) + arg1 = (mesh_surf(1, idx_node_nx)-mesh_surf(1, idx_node))**2 + + + (mesh_surf(3, idx_node_nx)-mesh_surf(3, idx_node))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN chord1_diff(idx_strip) = 0.D0 ELSE - chord1_diff(idx_strip) = arg1_diff/(2.0*temp0) + chord1_diff(idx_strip) = arg1_diff/(2.0*temp) END IF - chord1(idx_strip) = temp0 + chord1(idx_strip) = temp C idx_node_yp1 = FLATIDX(1, idx_y + 1, isurf) idx_node_nx_yp1 = FLATIDX(nx, idx_y + 1, isurf) @@ -1719,21 +1719,21 @@ SUBROUTINE MAKESURF_MESH_D(isurf) rle2(idx_dim, idx_strip) = mesh_surf(idx_dim, idx_node_yp1) ENDDO C Strip mid-point - temp0 = mesh_surf(1, idx_node_nx_yp1) - mesh_surf(1, - + idx_node_yp1) - temp = mesh_surf(3, idx_node_nx_yp1) - mesh_surf(3, - + idx_node_yp1) - arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_nx_yp1)- - + mesh_surf_diff(1, idx_node_yp1)) + 2*temp*(mesh_surf_diff(3 - + , idx_node_nx_yp1)-mesh_surf_diff(3, idx_node_yp1)) - arg1 = temp0*temp0 + temp*temp - temp0 = SQRT(arg1) + arg1_diff = 2*(mesh_surf(1, idx_node_nx_yp1)-mesh_surf(1, + + idx_node_yp1))*(mesh_surf_diff(1, idx_node_nx_yp1)- + + mesh_surf_diff(1, idx_node_yp1)) + 2*(mesh_surf(3, + + idx_node_nx_yp1)-mesh_surf(3, idx_node_yp1))*(mesh_surf_diff + + (3, idx_node_nx_yp1)-mesh_surf_diff(3, idx_node_yp1)) + arg1 = (mesh_surf(1, idx_node_nx_yp1)-mesh_surf(1, + + idx_node_yp1))**2 + (mesh_surf(3, idx_node_nx_yp1)-mesh_surf + + (3, idx_node_yp1))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN chord2_diff(idx_strip) = 0.D0 ELSE - chord2_diff(idx_strip) = arg1_diff/(2.0*temp0) + chord2_diff(idx_strip) = arg1_diff/(2.0*temp) END IF - chord2(idx_strip) = temp0 + chord2(idx_strip) = temp C C Since the strips are linear SPANWISE we can just interpolate DO idx_dim=1,3 @@ -1741,9 +1741,9 @@ SUBROUTINE MAKESURF_MESH_D(isurf) + )+rle2_diff(idx_dim, idx_strip))/2. rle(idx_dim, idx_strip) = (rle1(idx_dim, idx_strip)+rle2( + idx_dim, idx_strip))/2. + ENDDO C The strips are not necessarily linear chord wise but by definition the chord value is C so we can interpolate - ENDDO C Strip geometric incidence angle at the mid-point C This is strip incidence angle is computed from the LE and TE points C of the given geometry and is completely independent of AINC @@ -1770,13 +1770,13 @@ SUBROUTINE MAKESURF_MESH_D(isurf) C Strip LE and TE sweep slopes arg1_diff = 2*m2*m2_diff + 2*m3*m3_diff arg1 = m2**2 + m3**2 - temp0 = SQRT(arg1) + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN wstrip_diff(idx_strip) = 0.D0 ELSE - wstrip_diff(idx_strip) = arg1_diff/(2.0*temp0) + wstrip_diff(idx_strip) = arg1_diff/(2.0*temp) END IF - wstrip(idx_strip) = temp0 + wstrip(idx_strip) = temp C tanle(idx_strip) = (mesh_surf(1, idx_node_yp1)-mesh_surf(1, + idx_node))/wstrip(idx_strip) @@ -1834,15 +1834,15 @@ SUBROUTINE MAKESURF_MESH_D(isurf) chcos_g_diff = (1.0-fc)*chcosl_g_diff(n) + fc*chcosr_g_diff( + n) chcos_g = (1.0-fc)*chcosl_g(n) + fc*chcosr_g(n) - temp0 = chsin*chsin + chcos*chcos - temp = (chcos*chsin_g-chsin*chcos_g)/temp0 + temp = chsin*chsin + chcos*chcos + temp0 = (chcos*chsin_g-chsin*chcos_g)/temp ainc_g_diff(idx_strip, n) = (chsin_g*chcos_diff+chcos* - + chsin_g_diff-chcos_g*chsin_diff-chsin*chcos_g_diff-temp*(2 - + *chsin*chsin_diff+2*chcos*chcos_diff))/temp0 - ainc_g(idx_strip, n) = temp + + chsin_g_diff-chcos_g*chsin_diff-chsin*chcos_g_diff-temp0*( + + 2*chsin*chsin_diff+2*chcos*chcos_diff))/temp + ainc_g(idx_strip, n) = temp0 + ENDDO C We have to now setup any control surfaces we defined for this strip C Bring over the routine for this from makesurf but modified for a strip - ENDDO C DO n=1,ncontrol icl = isconl(n) @@ -1978,15 +1978,14 @@ SUBROUTINE MAKESURF_MESH_D(isurf) phinge(3, idx_strip, n) = rle(3, idx_strip) END IF END IF -C Interpolate CD-CL polar defining data from input to strips - ENDDO +C Interpolate CD-CL polar defining data from input to strips C DO idx_coef=1,6 clcd(idx_coef, idx_strip) = (1.0-fc)*clcdsec(idx_coef, iptl + , isurf) + fc*clcdsec(idx_coef, iptr, isurf) -C If the min drag is zero flag the strip as no-viscous data ENDDO +C If the min drag is zero flag the strip as no-viscous data C Set the panel (vortex) geometry data C Accumulate the strip element indicies and start counting vorticies lviscstrp(idx_strip) = clcd(4, idx_strip) .NE. 0.0 @@ -2026,12 +2025,13 @@ SUBROUTINE MAKESURF_MESH_D(isurf) DO idx_x=1,nvc(isurf) C Compute the panel left side chord idx_node = FLATIDX(idx_x, idx_y, isurf) - temp0 = mesh_surf(1, idx_node+1) - mesh_surf(1, idx_node) - temp = mesh_surf(3, idx_node+1) - mesh_surf(3, idx_node) - arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node+1)- - + mesh_surf_diff(1, idx_node)) + 2*temp*(mesh_surf_diff(3, - + idx_node+1)-mesh_surf_diff(3, idx_node)) - arg1 = temp0*temp0 + temp*temp + arg1_diff = 2*(mesh_surf(1, idx_node+1)-mesh_surf(1, + + idx_node))*(mesh_surf_diff(1, idx_node+1)-mesh_surf_diff(1 + + , idx_node)) + 2*(mesh_surf(3, idx_node+1)-mesh_surf(3, + + idx_node))*(mesh_surf_diff(3, idx_node+1)-mesh_surf_diff(3 + + , idx_node)) + arg1 = (mesh_surf(1, idx_node+1)-mesh_surf(1, idx_node))**2 + + + (mesh_surf(3, idx_node+1)-mesh_surf(3, idx_node))**2 temp0 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN dc1_diff = 0.D0 @@ -2043,19 +2043,19 @@ SUBROUTINE MAKESURF_MESH_D(isurf) C IF (lmeshflat(isurf)) THEN C Place vortex at panel quarter chord of the flat mesh - temp2 = mesh_surf(1, idx_node) - rle1(1, idx_strip) - temp1 = mesh_surf(3, idx_node) - rle1(3, idx_strip) - arg10_diff = 2*temp2*(mesh_surf_diff(1, idx_node)- - + rle1_diff(1, idx_strip)) + 2*temp1*(mesh_surf_diff(3, - + idx_node)-rle1_diff(3, idx_strip)) - arg10 = temp2*temp2 + temp1*temp1 - temp2 = SQRT(arg10) + arg10_diff = 2*(mesh_surf(1, idx_node)-rle1(1, idx_strip)) + + *(mesh_surf_diff(1, idx_node)-rle1_diff(1, idx_strip)) + + + 2*(mesh_surf(3, idx_node)-rle1(3, idx_strip))*( + + mesh_surf_diff(3, idx_node)-rle1_diff(3, idx_strip)) + arg10 = (mesh_surf(1, idx_node)-rle1(1, idx_strip))**2 + ( + + mesh_surf(3, idx_node)-rle1(3, idx_strip))**2 + temp3 = SQRT(arg10) IF (arg10 .EQ. 0.D0) THEN dx1_diff = 0.D0 ELSE - dx1_diff = arg10_diff/(2.0*temp2) + dx1_diff = arg10_diff/(2.0*temp3) END IF - dx1 = temp2 + dx1 = temp3 rv1_diff(2, idx_vor) = rle1_diff(2, idx_strip) rv1(2, idx_vor) = rle1(2, idx_strip) rv1_diff(3, idx_vor) = rle1_diff(3, idx_strip) @@ -2112,14 +2112,15 @@ SUBROUTINE MAKESURF_MESH_D(isurf) END IF C Compute the panel right side chord idx_node_yp1 = FLATIDX(idx_x, idx_y + 1, isurf) - temp0 = mesh_surf(1, idx_node_yp1+1) - mesh_surf(1, - + idx_node_yp1) - temp = mesh_surf(3, idx_node_yp1+1) - mesh_surf(3, - + idx_node_yp1) - arg1_diff = 2*temp0*(mesh_surf_diff(1, idx_node_yp1+1)- - + mesh_surf_diff(1, idx_node_yp1)) + 2*temp*(mesh_surf_diff( - + 3, idx_node_yp1+1)-mesh_surf_diff(3, idx_node_yp1)) - arg1 = temp0*temp0 + temp*temp + arg1_diff = 2*(mesh_surf(1, idx_node_yp1+1)-mesh_surf(1, + + idx_node_yp1))*(mesh_surf_diff(1, idx_node_yp1+1)- + + mesh_surf_diff(1, idx_node_yp1)) + 2*(mesh_surf(3, + + idx_node_yp1+1)-mesh_surf(3, idx_node_yp1))*( + + mesh_surf_diff(3, idx_node_yp1+1)-mesh_surf_diff(3, + + idx_node_yp1)) + arg1 = (mesh_surf(1, idx_node_yp1+1)-mesh_surf(1, + + idx_node_yp1))**2 + (mesh_surf(3, idx_node_yp1+1)- + + mesh_surf(3, idx_node_yp1))**2 temp0 = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN dc2_diff = 0.D0 @@ -2134,19 +2135,20 @@ SUBROUTINE MAKESURF_MESH_D(isurf) C IF (lmeshflat(isurf)) THEN C Place vortex at panel quarter chord of the flat mesh - temp2 = mesh_surf(1, idx_node_yp1) - rle2(1, idx_strip) - temp1 = mesh_surf(3, idx_node_yp1) - rle2(3, idx_strip) - arg10_diff = 2*temp2*(mesh_surf_diff(1, idx_node_yp1)- - + rle2_diff(1, idx_strip)) + 2*temp1*(mesh_surf_diff(3, - + idx_node_yp1)-rle2_diff(3, idx_strip)) - arg10 = temp2*temp2 + temp1*temp1 - temp2 = SQRT(arg10) + arg10_diff = 2*(mesh_surf(1, idx_node_yp1)-rle2(1, + + idx_strip))*(mesh_surf_diff(1, idx_node_yp1)-rle2_diff(1 + + , idx_strip)) + 2*(mesh_surf(3, idx_node_yp1)-rle2(3, + + idx_strip))*(mesh_surf_diff(3, idx_node_yp1)-rle2_diff(3 + + , idx_strip)) + arg10 = (mesh_surf(1, idx_node_yp1)-rle2(1, idx_strip))**2 + + + (mesh_surf(3, idx_node_yp1)-rle2(3, idx_strip))**2 + temp3 = SQRT(arg10) IF (arg10 .EQ. 0.D0) THEN dx2_diff = 0.D0 ELSE - dx2_diff = arg10_diff/(2.0*temp2) + dx2_diff = arg10_diff/(2.0*temp3) END IF - dx2 = temp2 + dx2 = temp3 C rv2_diff(2, idx_vor) = rle2_diff(2, idx_strip) rv2(2, idx_vor) = rle2(2, idx_strip) @@ -2240,22 +2242,23 @@ SUBROUTINE MAKESURF_MESH_D(isurf) C IF (lmeshflat(isurf)) THEN C Place vortex at panel quarter chord of the flat mesh - temp2 = (mesh_surf(1, idx_node_yp1)+mesh_surf(1, idx_node) - + )/2 - rle(1, idx_strip) - temp1 = (mesh_surf(3, idx_node_yp1)+mesh_surf(3, idx_node) - + )/2 - rle(3, idx_strip) - arg10_diff = 2*temp2*((mesh_surf_diff(1, idx_node_yp1)+ - + mesh_surf_diff(1, idx_node))/2-rle_diff(1, idx_strip)) + - + 2*temp1*((mesh_surf_diff(3, idx_node_yp1)+mesh_surf_diff - + (3, idx_node))/2-rle_diff(3, idx_strip)) - arg10 = temp2*temp2 + temp1*temp1 - temp2 = SQRT(arg10) + arg10_diff = 2*((mesh_surf(1, idx_node_yp1)+mesh_surf(1, + + idx_node))/2-rle(1, idx_strip))*((mesh_surf_diff(1, + + idx_node_yp1)+mesh_surf_diff(1, idx_node))/2-rle_diff(1 + + , idx_strip)) + 2*((mesh_surf(3, idx_node_yp1)+mesh_surf + + (3, idx_node))/2-rle(3, idx_strip))*((mesh_surf_diff(3, + + idx_node_yp1)+mesh_surf_diff(3, idx_node))/2-rle_diff(3 + + , idx_strip)) + arg10 = ((mesh_surf(1, idx_node_yp1)+mesh_surf(1, idx_node + + ))/2-rle(1, idx_strip))**2 + ((mesh_surf(3, idx_node_yp1 + + )+mesh_surf(3, idx_node))/2-rle(3, idx_strip))**2 + temp3 = SQRT(arg10) IF (arg10 .EQ. 0.D0) THEN dx3_diff = 0.D0 ELSE - dx3_diff = arg10_diff/(2.0*temp2) + dx3_diff = arg10_diff/(2.0*temp3) END IF - dx3 = temp2 + dx3 = temp3 rv_diff(2, idx_vor) = rle_diff(2, idx_strip) rv(2, idx_vor) = rle(2, idx_strip) rv_diff(3, idx_vor) = rle_diff(3, idx_strip) @@ -2393,25 +2396,25 @@ SUBROUTINE MAKESURF_MESH_D(isurf) END IF C C - temp2 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + temp3 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL AKIMA_D(xasec(1, iptl, isurf), xasec_diff(1, iptl, + isurf), sasec(1, iptl, isurf), sasec_diff(1, + iptl, isurf), nsl, (rc(1, idx_vor)-rle(1, + idx_strip))/chord(idx_strip), (rc_diff(1, - + idx_vor)-rle_diff(1, idx_strip)-temp2* + + idx_vor)-rle_diff(1, idx_strip)-temp3* + chord_diff(idx_strip))/chord(idx_strip), slopel + , slopel_diff, dsdx) -C Alternative for nonlinear sections per Hal Youngren -C SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER -C The original line is valid for interpolation over a strip - temp2 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + temp3 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL AKIMA_D(xasec(1, iptr, isurf), xasec_diff(1, iptr, + isurf), sasec(1, iptr, isurf), sasec_diff(1, + iptr, isurf), nsr, (rc(1, idx_vor)-rle(1, + idx_strip))/chord(idx_strip), (rc_diff(1, - + idx_vor)-rle_diff(1, idx_strip)-temp2* + + idx_vor)-rle_diff(1, idx_strip)-temp3* + chord_diff(idx_strip))/chord(idx_strip), sloper + , sloper_diff, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip C C Camber slope at vortex mid-point temp2 = chordl*slopel/chord(idx_strip) @@ -2422,25 +2425,25 @@ SUBROUTINE MAKESURF_MESH_D(isurf) + chord_diff(idx_strip))/chord(idx_strip) slopec(idx_vor) = (1.-fc)*temp2 + fc*temp1 C - temp2 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + temp3 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL AKIMA_D(xasec(1, iptl, isurf), xasec_diff(1, iptl, + isurf), sasec(1, iptl, isurf), sasec_diff(1, + iptl, isurf), nsl, (rv(1, idx_vor)-rle(1, + idx_strip))/chord(idx_strip), (rv_diff(1, - + idx_vor)-rle_diff(1, idx_strip)-temp2* + + idx_vor)-rle_diff(1, idx_strip)-temp3* + chord_diff(idx_strip))/chord(idx_strip), slopel + , slopel_diff, dsdx) -C Alternative for nonlinear sections per Hal Youngren -C SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER -C The original line is valid for interpolation over a strip - temp2 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) + temp3 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL AKIMA_D(xasec(1, iptr, isurf), xasec_diff(1, iptr, + isurf), sasec(1, iptr, isurf), sasec_diff(1, + iptr, isurf), nsr, (rv(1, idx_vor)-rle(1, + idx_strip))/chord(idx_strip), (rv_diff(1, - + idx_vor)-rle_diff(1, idx_strip)-temp2* + + idx_vor)-rle_diff(1, idx_strip)-temp3* + chord_diff(idx_strip))/chord(idx_strip), sloper + , sloper_diff, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip C C Associate the panel with strip chord and component temp2 = chordl*slopel/chord(idx_strip) @@ -2471,21 +2474,21 @@ SUBROUTINE MAKESURF_MESH_D(isurf) + chord_diff(idx_strip))/chord(idx_strip) xpt = temp2 C - temp2 = chord(idx_strip)/dxv(idx_vor) - temp1 = xled(n)/chord(idx_strip) - fracle_diff = temp2*((xled_diff(n)-temp1*chord_diff( - + idx_strip))/chord(idx_strip)-xpt_diff) + (temp1-xpt)*( - + chord_diff(idx_strip)-temp2*dxv_diff(idx_vor))/dxv( + temp3 = chord(idx_strip)/dxv(idx_vor) + temp2 = xled(n)/chord(idx_strip) + fracle_diff = temp3*((xled_diff(n)-temp2*chord_diff( + + idx_strip))/chord(idx_strip)-xpt_diff) + (temp2-xpt)*( + + chord_diff(idx_strip)-temp3*dxv_diff(idx_vor))/dxv( + idx_vor) - fracle = (temp1-xpt)*temp2 + fracle = (temp2-xpt)*temp3 C - temp2 = chord(idx_strip)/dxv(idx_vor) - temp1 = xted(n)/chord(idx_strip) - fracte_diff = temp2*((xted_diff(n)-temp1*chord_diff( - + idx_strip))/chord(idx_strip)-xpt_diff) + (temp1-xpt)*( - + chord_diff(idx_strip)-temp2*dxv_diff(idx_vor))/dxv( + temp3 = chord(idx_strip)/dxv(idx_vor) + temp2 = xted(n)/chord(idx_strip) + fracte_diff = temp3*((xted_diff(n)-temp2*chord_diff( + + idx_strip))/chord(idx_strip)-xpt_diff) + (temp2-xpt)*( + + chord_diff(idx_strip)-temp3*dxv_diff(idx_vor))/dxv( + idx_vor) - fracte = (temp1-xpt)*temp2 + fracte = (temp2-xpt)*temp3 IF (0.0 .LT. fracle) THEN y1_diff = fracle_diff y1 = fracle @@ -2518,8 +2521,8 @@ SUBROUTINE MAKESURF_MESH_D(isurf) dcontrol_diff(idx_vor, n) = gainda(n)*(fracte_diff- + fracle_diff) dcontrol(idx_vor, n) = gainda(n)*(fracte-fracle) -C TE control point used only if surface sheds a wake ENDDO +C TE control point used only if surface sheds a wake C Use the cross sections to generate the OML C nodal grid associated with vortex strip (aft-panel nodes) C NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; @@ -2539,16 +2542,16 @@ SUBROUTINE MAKESURF_MESH_D(isurf) C CALL AKIMA(xlasec(1, iptl, isurf), zlasec(1, iptl, isurf), + nsl, xptxind1, zl_l, dsdx) -C Interpolate cross section on right side CALL AKIMA(xuasec(1, iptl, isurf), zuasec(1, iptl, isurf), + nsl, xptxind1, zu_l, dsdx) +C Interpolate cross section on right side C CALL AKIMA(xlasec(1, iptr, isurf), zlasec(1, iptr, isurf), + nsr, xptxind1, zl_r, dsdx) -C Compute the left aft node of panel -C X-point CALL AKIMA(xuasec(1, iptr, isurf), zuasec(1, iptr, isurf), + nsr, xptxind1, zu_r, dsdx) +C Compute the left aft node of panel +C X-point C C C Y-point @@ -2581,12 +2584,12 @@ SUBROUTINE MAKESURF_MESH_D(isurf) zupn2(idx_vor) = rle2(3, idx_strip) + zu*chord2(idx_strip) C idx_vor = idx_vor + 1 -C End vortex loop ENDDO +C End vortex loop idx_strip = idx_strip + 1 + ENDDO C End strip loop C Compute the wetted area and cave from the true mesh - ENDDO C sum = 0.0 wtot = 0.0 @@ -2777,9 +2780,9 @@ SUBROUTINE SDUPL_D(nn, ypt, msg) phinge(1, jji, n) = phinge(1, jj, n) phinge(2, jji, n) = -phinge(2, jj, n) + yoff phinge(3, jji, n) = phinge(3, jj, n) + ENDDO C IJFRST(JJI) = NVOR + 1 C IJFRST(JJI) = IJFRST(NSTRIP - 1) + NVC(NNI) - ENDDO C C--- The defined section for image strip is flagged with (-) ijfrst(jji) = ijfrst(jji-1) + nvstrp(jji-1) @@ -2992,8 +2995,7 @@ SUBROUTINE ENCALC_D() REAL arg10_diff REAL(kind=avl_real) temp REAL temp0 - REAL(kind=avl_real) temp1 - REAL(kind=avl_real) temp2 + REAL(kind=8) temp1 INTEGER ii1 INTEGER ii3 INTEGER ii2 @@ -3076,6 +3078,7 @@ SUBROUTINE ENCALC_D() C C dchstrip = 0.0 +C compute the spanwise unit vector for Vperp def searchsaxfr:DO i=ijfrst(j),ijfrst(j)+(nvstrp(j)-1) dchstrip = dchstrip + dxstrpv(i) IF (dchstrip .GE. chord(j)*saxfr) EXIT @@ -3312,28 +3315,27 @@ SUBROUTINE ENCALC_D() C plane C C - temp = rcmsh(1, i) - rvmsh(1, i) - temp1 = rcmsh(2, i) - rvmsh(2, i) - temp2 = rcmsh(3, i) - rvmsh(3, i) - arg1_diff = 2*temp*(rcmsh_diff(1, i)-rvmsh_diff(1, i)) + 2* - + temp1*(rcmsh_diff(2, i)-rvmsh_diff(2, i)) + 2*temp2*( - + rcmsh_diff(3, i)-rvmsh_diff(3, i)) - arg1 = temp*temp + temp1*temp1 + temp2*temp2 - temp2 = SQRT(arg1) + arg1_diff = 2*(rcmsh(1, i)-rvmsh(1, i))*(rcmsh_diff(1, i)- + + rvmsh_diff(1, i)) + 2*(rcmsh(2, i)-rvmsh(2, i))*( + + rcmsh_diff(2, i)-rvmsh_diff(2, i)) + 2*(rcmsh(3, i)-rvmsh( + + 3, i))*(rcmsh_diff(3, i)-rvmsh_diff(3, i)) + arg1 = (rcmsh(1, i)-rvmsh(1, i))**2 + (rcmsh(2, i)-rvmsh(2, + + i))**2 + (rcmsh(3, i)-rvmsh(3, i))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN emag_diff = 0.D0 ELSE - emag_diff = arg1_diff/(2.0*temp2) + emag_diff = arg1_diff/(2.0*temp) END IF - emag = temp2 - temp2 = (rcmsh(1, i)-rvmsh(1, i))/emag - ec_msh_diff(1) = (rcmsh_diff(1, i)-rvmsh_diff(1, i)-temp2* + emag = temp + temp1 = (rcmsh(1, i)-rvmsh(1, i))/emag + ec_msh_diff(1) = (rcmsh_diff(1, i)-rvmsh_diff(1, i)-temp1* + emag_diff)/emag - ec_msh(1) = temp2 - temp2 = (rcmsh(2, i)-rvmsh(2, i))/emag - ec_msh_diff(2) = (rcmsh_diff(2, i)-rvmsh_diff(2, i)-temp2* + ec_msh(1) = temp1 + temp1 = (rcmsh(2, i)-rvmsh(2, i))/emag + ec_msh_diff(2) = (rcmsh_diff(2, i)-rvmsh_diff(2, i)-temp1* + emag_diff)/emag - ec_msh(2) = temp2 + ec_msh(2) = temp1 C Now we have to rotate this vector by the incidence contribution from AINC and CAMBER C However, this rotation needs to be done about the local y-axis of the wing C Earlier we computed ES the normal vector of the strip projected to the Trefftz plane @@ -3347,10 +3349,10 @@ SUBROUTINE ENCALC_D() C see https://pubs.aip.org/aapt/ajp/article/44/1/63/1050167/Formalism-for-the-rotation-matrix-of-rotations C Note that standard AVL also does this exact same thing but since they always rotate the vector [1,0,0] C the result collapses into the ridiculously simple expression for EC that you see in the other branch - temp2 = (rcmsh(3, i)-rvmsh(3, i))/emag - ec_msh_diff(3) = (rcmsh_diff(3, i)-rvmsh_diff(3, i)-temp2* + temp1 = (rcmsh(3, i)-rvmsh(3, i))/emag + ec_msh_diff(3) = (rcmsh_diff(3, i)-rvmsh_diff(3, i)-temp1* + emag_diff)/emag - ec_msh(3) = temp2 + ec_msh(3) = temp1 C C ec_diff(1) = ec_msh(1)*cosc_diff + cosc*ec_msh_diff(1) + diff --git a/src/ad_src/forward_ad_src/amode_d.f b/src/ad_src/forward_ad_src/amode_d.f index 80de7fd..623dfa5 100644 --- a/src/ad_src/forward_ad_src/amode_d.f +++ b/src/ad_src/forward_ad_src/amode_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of set_params in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: mach @@ -8,6 +8,7 @@ C C SUBROUTINE SET_PARAMS_D(ir) +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER ir @@ -54,6 +55,5 @@ SUBROUTINE SET_PARAMS_D(ir) rixy = parval(ipixy, ir) riyz = parval(ipiyz, ir) rizx = parval(ipizx, ir) -C END diff --git a/src/ad_src/forward_ad_src/aoper_d.f b/src/ad_src/forward_ad_src/aoper_d.f index 50d41ba..511c0cf 100644 --- a/src/ad_src/forward_ad_src/aoper_d.f +++ b/src/ad_src/forward_ad_src/aoper_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of calc_stab_derivs in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: cxtot_u_ba cytot_u_ba cztot_u_ba @@ -55,9 +55,9 @@ SUBROUTINE CALC_STAB_DERIVS_D() INTEGER ii1 REAL(kind=avl_real) temp C + CALL GETSA(lnasa_sa, satype, dir) C CALL VINFAB C CALL AERO - CALL GETSA(lnasa_sa, satype, dir) C C---- set freestream velocity components from alpha, beta C @@ -577,8 +577,8 @@ SUBROUTINE CALC_STAB_DERIVS_D() cmtot_d_ba(k) = cmtot_d(2, k) cntot_d_ba_diff(k) = dir*cmtot_d_diff(3, k) cntot_d_ba(k) = dir*cmtot_d(3, k) -C design variables ENDDO +C design variables DO k=1,ndesign cxtot_g_ba(k) = dir*cftot_g(1, k) cytot_g_ba(k) = cftot_g(2, k) @@ -612,6 +612,7 @@ SUBROUTINE CALC_STAB_DERIVS_D() C C ======================== res and Adjoint for GAM ======== SUBROUTINE GET_RES_D() +C use avl_heap_inc use avl_heap_diff_inc INCLUDE 'AVL.INC' @@ -629,11 +630,11 @@ SUBROUTINE GET_RES_D() REAL(kind=avl_real) temp INTEGER ii1 INTEGER ii2 + CALL SET_PAR_AND_CONS_D(nitmax, irun) C Do not use this routine in the sovler C IF(.NOT.LAIC) THEN C CALL build_AIC C end if - CALL SET_PAR_AND_CONS_D(nitmax, irun) C--- CALL BUILD_AIC_D() amach_diff = mach_diff @@ -699,14 +700,12 @@ SUBROUTINE GET_RES_D() ENDDO CALL SET_VEL_RHS_D() C -C$AD II-LOOP CALL MAT_PROD_D(aicn, aicn_diff, gam, gam_diff, nvor, res, + res_diff) C---- add the RHS vector to the residual DO i=1,nvor res_diff(i) = res_diff(i) - rhs_diff(i) res(i) = res(i) - rhs(i) -C$AD II-LOOP ENDDO DO ii1=1,ndmax DO ii2=1,nvor @@ -719,10 +718,9 @@ SUBROUTINE GET_RES_D() DO ic=1,ncontrol C------ don't bother if this control variable is undefined IF (lcondef(ic)) THEN -C RHS_D(:) = 0.D0 CALL MAT_PROD_D(aicn, aicn_diff, gam_d(:, ic), gam_d_diff(:, + ic), nvor, res_d(:, ic), res_d_diff(:, ic)) -C$AD II-LOOP +C RHS_D(:) = 0.D0 CALL SET_GAM_D_RHS_D(ic, enc_d, enc_d_diff, rhs_d, rhs_d_diff) DO i=1,nvor res_d_diff(i, ic) = res_d_diff(i, ic) - rhs_d_diff(i) @@ -730,7 +728,5 @@ SUBROUTINE GET_RES_D() ENDDO END IF ENDDO -C - END diff --git a/src/ad_src/forward_ad_src/asetup_d.f b/src/ad_src/forward_ad_src/asetup_d.f index da329fa..94ef1ec 100644 --- a/src/ad_src/forward_ad_src/asetup_d.f +++ b/src/ad_src/forward_ad_src/asetup_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of build_aic in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: aicn @@ -245,10 +245,9 @@ SUBROUTINE VELSUM_D() wc_g(k, i, n) = vc_g(k, i, n) wv_g(k, i, n) = vv_g(k, i, n) ENDDO -C - ENDDO ENDDO +C C RETURN END @@ -267,8 +266,8 @@ SUBROUTINE SET_PAR_AND_CONS_D(niter, ir) INTEGER iv INTEGER ic INTEGER ii1 -C Additionally set the reference point to be at the cg CALL SET_PARAMS_D(ir) +C Additionally set the reference point to be at the cg xyzref_diff(1) = parval_diff(ipxcg, ir) xyzref(1) = parval(ipxcg, ir) xyzref_diff(2) = parval_diff(ipycg, ir) @@ -351,6 +350,7 @@ SUBROUTINE SET_PAR_AND_CONS_D(niter, ir) C with respect to varying inputs: vinf wrot delcon xyzref rc C enc enc_d wcsrd_u SUBROUTINE SET_VEL_RHS_D() +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' REAL rrot(3), vunit(3), vunit_w_term(3), wunit(3) @@ -464,8 +464,6 @@ SUBROUTINE SET_VEL_RHS_D() rhs(i) = 0 END IF ENDDO -C - END C Differentiation of set_vel_rhs_u in forward (tangent) mode (with options i4 dr8 r8): diff --git a/src/ad_src/forward_ad_src/atpforc_d.f b/src/ad_src/forward_ad_src/atpforc_d.f index 1dddf93..54d7414 100644 --- a/src/ad_src/forward_ad_src/atpforc_d.f +++ b/src/ad_src/forward_ad_src/atpforc_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of tpforc in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: clff cyff cdff spanef @@ -92,8 +92,9 @@ SUBROUTINE TPFORC_D() REAL arg1_diff REAL temp REAL temp0 - REAL(kind=avl_real) temp1 + REAL(kind=8) temp1 REAL(kind=avl_real) temp2 + REAL(kind=8) temp3 INTEGER ii1 INTEGER ii2 C @@ -159,8 +160,6 @@ SUBROUTINE TPFORC_D() gams_g(jc, n) = gams_g(jc, n) + gam_g(i, n) ENDDO ENDDO -Ccc ENDIF - ENDDO DO ii1=1,NSTRIP DO ii2=1,3 @@ -177,6 +176,7 @@ SUBROUTINE TPFORC_D() rt1_diff(ii2, ii1) = 0.D0 ENDDO ENDDO +Ccc ENDIF C C---- set x,y,z in wind axes (Y,Z are then in Trefftz plane) DO jc=1,nstrip @@ -237,18 +237,17 @@ SUBROUTINE TPFORC_D() C C...Sum velocity contributions from wake vortices DO jv=1,nstrip - temp = rt2(2, jv) - rt1(2, jv) - temp0 = rt2(3, jv) - rt1(3, jv) - arg1_diff = 2*temp*(rt2_diff(2, jv)-rt1_diff(2, jv)) + 2*temp0 - + *(rt2_diff(3, jv)-rt1_diff(3, jv)) - arg1 = temp*temp + temp0*temp0 - temp0 = SQRT(arg1) + arg1_diff = 2*(rt2(2, jv)-rt1(2, jv))*(rt2_diff(2, jv)- + + rt1_diff(2, jv)) + 2*(rt2(3, jv)-rt1(3, jv))*(rt2_diff(3, jv + + )-rt1_diff(3, jv)) + arg1 = (rt2(2, jv)-rt1(2, jv))**2 + (rt2(3, jv)-rt1(3, jv))**2 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN dsyz_diff = 0.D0 ELSE - dsyz_diff = arg1_diff/(2.0*temp0) + dsyz_diff = arg1_diff/(2.0*temp) END IF - dsyz = temp0 + dsyz = temp IF (lncomp(lssurf(jc)) .EQ. lncomp(lssurf(jv))) THEN Ccc RCORE = 0.0001*DSYZ rcore = 0. @@ -269,40 +268,38 @@ SUBROUTINE TPFORC_D() dz1 = zcntr - rt1(3, jv) dz2_diff = zcntr_diff - rt2_diff(3, jv) dz2 = zcntr - rt2(3, jv) - temp0 = dy1*dy1 + dz1*dz1 - arg1_diff = 2*temp0*(2*dy1*dy1_diff+2*dz1*dz1_diff) + 4*rcore - + **3*rcore_diff - arg1 = temp0*temp0 + rcore**4 - temp0 = SQRT(arg1) + arg1_diff = 2*(dy1**2+dz1**2)*(2*dy1*dy1_diff+2*dz1*dz1_diff) + + + 4*rcore**3*rcore_diff + arg1 = (dy1**2+dz1**2)**2 + rcore**4 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN rsq1_diff = 0.D0 ELSE - rsq1_diff = arg1_diff/(2.0*temp0) + rsq1_diff = arg1_diff/(2.0*temp) END IF - rsq1 = temp0 - temp0 = dy2*dy2 + dz2*dz2 - arg1_diff = 2*temp0*(2*dy2*dy2_diff+2*dz2*dz2_diff) + 4*rcore - + **3*rcore_diff - arg1 = temp0*temp0 + rcore**4 - temp0 = SQRT(arg1) + rsq1 = temp + arg1_diff = 2*(dy2**2+dz2**2)*(2*dy2*dy2_diff+2*dz2*dz2_diff) + + + 4*rcore**3*rcore_diff + arg1 = (dy2**2+dz2**2)**2 + rcore**4 + temp = SQRT(arg1) IF (arg1 .EQ. 0.D0) THEN rsq2_diff = 0.D0 ELSE - rsq2_diff = arg1_diff/(2.0*temp0) + rsq2_diff = arg1_diff/(2.0*temp) END IF - rsq2 = temp0 + rsq2 = temp Cc RSQ1 = DY1*DY1 + DZ1*DZ1 + RCORE**2 Cc RSQ2 = DY2*DY2 + DZ2*DZ2 + RCORE**2 - temp0 = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff + hpi*(temp0*gams_diff(jv)+gams(jv)*(( + temp = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff + hpi*(temp*gams_diff(jv)+gams(jv)*(( + dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2*rsq2_diff/ + rsq2)/rsq2)) - vy = vy + hpi*(gams(jv)*temp0) - temp0 = dy2/rsq2 - dy1/rsq1 - vz_diff = vz_diff + hpi*(temp0*gams_diff(jv)+gams(jv)*(( + vy = vy + hpi*(gams(jv)*temp) + temp = dy2/rsq2 - dy1/rsq1 + vz_diff = vz_diff + hpi*(temp*gams_diff(jv)+gams(jv)*(( + dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1*rsq1_diff/ + rsq1)/rsq1)) - vz = vz + hpi*(gams(jv)*temp0) + vz = vz + hpi*(gams(jv)*temp) DO n=1,numax vy_u(n) = vy_u(n) + hpi*gams_u(jv, n)*(dz1/rsq1-dz2/rsq2) vz_u(n) = vz_u(n) + hpi*gams_u(jv, n)*(-(dy1/rsq1)+dy2/rsq2) @@ -331,16 +328,16 @@ SUBROUTINE TPFORC_D() rsq1 = dy1*dy1 + dz1*dz1 rsq2_diff = 2*dy2*dy2_diff + 2*dz2*dz2_diff rsq2 = dy2*dy2 + dz2*dz2 - temp0 = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff - hpi*izsym*(temp0*gams_diff(jv)+gams(jv)* - + ((dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2* - + rsq2_diff/rsq2)/rsq2)) - vy = vy - hpi*izsym*(gams(jv)*temp0) - temp0 = dy2/rsq2 - dy1/rsq1 - vz_diff = vz_diff - hpi*izsym*(temp0*gams_diff(jv)+gams(jv)* - + ((dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1* - + rsq1_diff/rsq1)/rsq1)) - vz = vz - hpi*izsym*(gams(jv)*temp0) + temp = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff - hpi*izsym*(temp*gams_diff(jv)+gams(jv)*( + + (dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2*rsq2_diff + + /rsq2)/rsq2)) + vy = vy - hpi*izsym*(gams(jv)*temp) + temp = dy2/rsq2 - dy1/rsq1 + vz_diff = vz_diff - hpi*izsym*(temp*gams_diff(jv)+gams(jv)*( + + (dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1*rsq1_diff + + /rsq1)/rsq1)) + vz = vz - hpi*izsym*(gams(jv)*temp) DO n=1,numax vy_u(n) = vy_u(n) - hpi*gams_u(jv, n)*(dz1/rsq1-dz2/rsq2)* + izsym @@ -374,16 +371,16 @@ SUBROUTINE TPFORC_D() rsq1 = dy1*dy1 + dz1*dz1 rsq2_diff = 2*dy2*dy2_diff + 2*dz2*dz2_diff rsq2 = dy2*dy2 + dz2*dz2 - temp0 = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff - hpi*iysym*(temp0*gams_diff(jv)+gams(jv)* - + ((dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2* - + rsq2_diff/rsq2)/rsq2)) - vy = vy - hpi*iysym*(gams(jv)*temp0) - temp0 = dy2/rsq2 - dy1/rsq1 - vz_diff = vz_diff - hpi*iysym*(temp0*gams_diff(jv)+gams(jv)* - + ((dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1* - + rsq1_diff/rsq1)/rsq1)) - vz = vz - hpi*iysym*(gams(jv)*temp0) + temp = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff - hpi*iysym*(temp*gams_diff(jv)+gams(jv)*( + + (dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2*rsq2_diff + + /rsq2)/rsq2)) + vy = vy - hpi*iysym*(gams(jv)*temp) + temp = dy2/rsq2 - dy1/rsq1 + vz_diff = vz_diff - hpi*iysym*(temp*gams_diff(jv)+gams(jv)*( + + (dy2_diff-dy2*rsq2_diff/rsq2)/rsq2-(dy1_diff-dy1*rsq1_diff + + /rsq1)/rsq1)) + vz = vz - hpi*iysym*(gams(jv)*temp) DO n=1,numax vy_u(n) = vy_u(n) - hpi*gams_u(jv, n)*(dz1/rsq1-dz2/rsq2)* + iysym @@ -418,12 +415,12 @@ SUBROUTINE TPFORC_D() rsq1 = dy1*dy1 + dz1*dz1 rsq2_diff = 2*dy2*dy2_diff + 2*dz2*dz2_diff rsq2 = dy2*dy2 + dz2*dz2 - temp0 = hpi*iysym*izsym - temp = dz1/rsq1 - dz2/rsq2 - vy_diff = vy_diff + temp0*(temp*gams_diff(jv)+gams(jv)*(( + temp = hpi*iysym*izsym + temp0 = dz1/rsq1 - dz2/rsq2 + vy_diff = vy_diff + temp*(temp0*gams_diff(jv)+gams(jv)*(( + dz1_diff-dz1*rsq1_diff/rsq1)/rsq1-(dz2_diff-dz2* + rsq2_diff/rsq2)/rsq2)) - vy = vy + temp0*(gams(jv)*temp) + vy = vy + temp*(gams(jv)*temp0) temp0 = hpi*iysym*izsym temp = dy2/rsq2 - dy1/rsq1 vz_diff = vz_diff + temp0*(temp*gams_diff(jv)+gams(jv)*(( @@ -526,9 +523,9 @@ SUBROUTINE TPFORC_D() C--------------------------------------------------------- C C---- aspect ratio - temp1 = bref*bref/sref - ar_diff = (2*bref*bref_diff-temp1*sref_diff)/sref - ar = temp1 + temp2 = bref*bref/sref + ar_diff = (2*bref*bref_diff-temp2*sref_diff)/sref + ar = temp2 C C---- span efficiency IF (cdff .EQ. 0.0) THEN @@ -547,10 +544,10 @@ SUBROUTINE TPFORC_D() ELSE C temp1 = pi*ar*cdff - temp2 = (clff*clff+cyff*cyff)/temp1 - spanef_diff = (2*clff*clff_diff+2*cyff*cyff_diff-temp2*(cdff*pi* + temp3 = (clff*clff+cyff*cyff)/temp1 + spanef_diff = (2*clff*clff_diff+2*cyff*cyff_diff-temp3*(cdff*pi* + ar_diff+pi*ar*cdff_diff))/temp1 - spanef = temp2 + spanef = temp3 spanef_cl = 2.0*clff/(pi*ar*cdff) spanef_cy = 2.0*cyff/(pi*ar*cdff) spanef_cd = -(spanef/cdff) diff --git a/src/ad_src/forward_ad_src/cdcl_d.f b/src/ad_src/forward_ad_src/cdcl_d.f index d1a2859..cf7d1b6 100644 --- a/src/ad_src/forward_ad_src/cdcl_d.f +++ b/src/ad_src/forward_ad_src/cdcl_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of cdcl in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: cd_cl cd diff --git a/src/ad_src/forward_ad_src/sgutil_d.f b/src/ad_src/forward_ad_src/sgutil_d.f index 3bb392a..df8203a 100644 --- a/src/ad_src/forward_ad_src/sgutil_d.f +++ b/src/ad_src/forward_ad_src/sgutil_d.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of akima in forward (tangent) mode (with options i4 dr8 r8): C variations of useful results: yy @@ -434,8 +434,8 @@ SUBROUTINE CSPACER_D(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, xsr(ivc) = f0*xsr0 + f1*xsr1 + f2*xsr2 xcp_diff(ivc) = f0*xcp0_diff + f1*xcp1_diff + f2*xcp2_diff xcp(ivc) = f0*xcp0 + f1*xcp1 + f2*xcp2 -C ENDDO +C xpt(1) = 0.0 xpt(nvc+1) = 1.0 C diff --git a/src/ad_src/reverse_ad_src/aero_b.f b/src/ad_src/reverse_ad_src/aero_b.f index 53a68e0..d9f76a2 100644 --- a/src/ad_src/reverse_ad_src/aero_b.f +++ b/src/ad_src/reverse_ad_src/aero_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of aero in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: clff cyff cdff spanef cdtot @@ -102,9 +102,9 @@ SUBROUTINE AERO_B() REAL dir EXTERNAL GETSA INTEGER is - REAL(kind=avl_real) temp - REAL(kind=avl_real) temp_diff - INTEGER*4 branch + REAL(kind=8) temp + REAL(kind=8) temp_diff + INTEGER branch INTEGER ii1 C cdtot = 0. @@ -584,10 +584,10 @@ SUBROUTINE SFFORC_B() REAL result2 REAL temp_diff INTEGER ii1 - INTEGER*4 branch + INTEGER branch REAL temp_diff0 REAL temp_diff1 - REAL(kind=avl_real) temp_diff2 + REAL(kind=8) temp_diff2 REAL(kind=avl_real) temp_diff3 INTEGER ii2 INTEGER ii3 @@ -699,13 +699,6 @@ SUBROUTINE SFFORC_B() DO n=1,numax ulift_u(k, n) = (ulift_u(k, n)-ulift(k)*ulmag_u(n))/ulmag ENDDO -C write(6,*) 'Strip J ',J -C write(6,*) 'UDRAG ',UDRAG -C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG -C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) -C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) -C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) - ENDDO END IF C @@ -1541,6 +1534,10 @@ SUBROUTINE SFFORC_B() C XXSURF values normalized to configuration reference quantities SREF,CREF,BREF about XYZref C XX_LSRF values normalized to each surface's reference quantities (area and average chord) DO is=1,nsurf + CALL PUSHINTEGER4(l) + CALL PUSHINTEGER4(j) + CALL PUSHREAL8(sr) + CALL PUSHREAL8(cr) C C--- Surface hinge moments defined by surface LE moment about hinge vector Ccc CMLE_LSRF(IS) = DOT(CM_LSRF(1,IS),VHINGE(1,IS)) @@ -1787,134 +1784,134 @@ SUBROUTINE SFFORC_B() sr_diff = 0.D0 cr_diff = 0.D0 DO n=ncontrol,1,-1 - temp_diff3 = cms_d_diff(3, is, n)/(sref*bref) + temp_diff2 = cms_d_diff(3, is, n)/(sref*bref) cmst_d_diff(3, j, n) = cmst_d_diff(3, j, n) + sr*cr* - + temp_diff3 - temp_diff1 = cmst_d(3, j, n)*temp_diff3 - temp_diff2 = -(cmst_d(3, j, n)*sr*cr*temp_diff3/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff2 - bref_diff = bref_diff + sref*temp_diff2 + + temp_diff2 + temp_diff1 = cmst_d(3, j, n)*temp_diff2 + temp_diff3 = -(cmst_d(3, j, n)*sr*cr*temp_diff2/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff3 + bref_diff = bref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff3 = cms_d_diff(2, is, n)/(sref*cref) + temp_diff2 = cms_d_diff(2, is, n)/(sref*cref) cmst_d_diff(2, j, n) = cmst_d_diff(2, j, n) + sr*cr* - + temp_diff3 - temp_diff1 = cmst_d(2, j, n)*temp_diff3 - temp_diff2 = -(cmst_d(2, j, n)*sr*cr*temp_diff3/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff2 - cref_diff = cref_diff + sref*temp_diff2 + + temp_diff2 + temp_diff1 = cmst_d(2, j, n)*temp_diff2 + temp_diff3 = -(cmst_d(2, j, n)*sr*cr*temp_diff2/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff3 + cref_diff = cref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff3 = cms_d_diff(1, is, n)/(sref*bref) + temp_diff2 = cms_d_diff(1, is, n)/(sref*bref) cmst_d_diff(1, j, n) = cmst_d_diff(1, j, n) + sr*cr* - + temp_diff3 - temp_diff1 = cmst_d(1, j, n)*temp_diff3 - temp_diff2 = -(cmst_d(1, j, n)*sr*cr*temp_diff3/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff2 - bref_diff = bref_diff + sref*temp_diff2 + + temp_diff2 + temp_diff1 = cmst_d(1, j, n)*temp_diff2 + temp_diff3 = -(cmst_d(1, j, n)*sr*cr*temp_diff2/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff3 + bref_diff = bref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 DO l=3,1,-1 cfst_d_diff(l, j, n) = cfst_d_diff(l, j, n) + sr* + cfs_d_diff(l, is, n)/sref - temp_diff3 = cfst_d(l, j, n)*cfs_d_diff(l, is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cfst_d(l, j, n)*cfs_d_diff(l, is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref ENDDO clst_d_diff(j, n) = clst_d_diff(j, n) + sr*cls_d_diff(is, n) + /sref - temp_diff3 = clst_d(j, n)*cls_d_diff(is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = clst_d(j, n)*cls_d_diff(is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref cyst_d_diff(j, n) = cyst_d_diff(j, n) + sr*cys_d_diff(is, n) + /sref - temp_diff3 = cyst_d(j, n)*cys_d_diff(is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cyst_d(j, n)*cys_d_diff(is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref cdst_d_diff(j, n) = cdst_d_diff(j, n) + sr*cds_d_diff(is, n) + /sref - temp_diff3 = cdst_d(j, n)*cds_d_diff(is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cdst_d(j, n)*cds_d_diff(is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref ENDDO DO n=numax,1,-1 - temp_diff3 = cms_u_diff(3, is, n)/(sref*bref) + temp_diff2 = cms_u_diff(3, is, n)/(sref*bref) cmst_u_diff(3, j, n) = cmst_u_diff(3, j, n) + sr*cr* - + temp_diff3 - temp_diff1 = cmst_u(3, j, n)*temp_diff3 - temp_diff2 = -(cmst_u(3, j, n)*sr*cr*temp_diff3/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff2 - bref_diff = bref_diff + sref*temp_diff2 + + temp_diff2 + temp_diff1 = cmst_u(3, j, n)*temp_diff2 + temp_diff3 = -(cmst_u(3, j, n)*sr*cr*temp_diff2/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff3 + bref_diff = bref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff3 = cms_u_diff(2, is, n)/(sref*cref) + temp_diff2 = cms_u_diff(2, is, n)/(sref*cref) cmst_u_diff(2, j, n) = cmst_u_diff(2, j, n) + sr*cr* - + temp_diff3 - temp_diff1 = cmst_u(2, j, n)*temp_diff3 - temp_diff2 = -(cmst_u(2, j, n)*sr*cr*temp_diff3/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff2 - cref_diff = cref_diff + sref*temp_diff2 + + temp_diff2 + temp_diff1 = cmst_u(2, j, n)*temp_diff2 + temp_diff3 = -(cmst_u(2, j, n)*sr*cr*temp_diff2/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff3 + cref_diff = cref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff3 = cms_u_diff(1, is, n)/(sref*bref) + temp_diff2 = cms_u_diff(1, is, n)/(sref*bref) cmst_u_diff(1, j, n) = cmst_u_diff(1, j, n) + sr*cr* - + temp_diff3 - temp_diff1 = cmst_u(1, j, n)*temp_diff3 - temp_diff2 = -(cmst_u(1, j, n)*sr*cr*temp_diff3/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff2 - bref_diff = bref_diff + sref*temp_diff2 + + temp_diff2 + temp_diff1 = cmst_u(1, j, n)*temp_diff2 + temp_diff3 = -(cmst_u(1, j, n)*sr*cr*temp_diff2/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff3 + bref_diff = bref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 DO l=3,1,-1 cfst_u_diff(l, j, n) = cfst_u_diff(l, j, n) + sr* + cfs_u_diff(l, is, n)/sref - temp_diff3 = cfst_u(l, j, n)*cfs_u_diff(l, is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cfst_u(l, j, n)*cfs_u_diff(l, is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref ENDDO clst_u_diff(j, n) = clst_u_diff(j, n) + sr*cls_u_diff(is, n) + /sref - temp_diff3 = clst_u(j, n)*cls_u_diff(is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = clst_u(j, n)*cls_u_diff(is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref cyst_u_diff(j, n) = cyst_u_diff(j, n) + sr*cys_u_diff(is, n) + /sref - temp_diff3 = cyst_u(j, n)*cys_u_diff(is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cyst_u(j, n)*cys_u_diff(is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref cdst_u_diff(j, n) = cdst_u_diff(j, n) + sr*cds_u_diff(is, n) + /sref - temp_diff3 = cdst_u(j, n)*cds_u_diff(is, n)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cdst_u(j, n)*cds_u_diff(is, n)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref ENDDO clst_a_diff(j) = clst_a_diff(j) + sr*cls_a_diff(is)/sref - temp_diff3 = clst_a(j)*cls_a_diff(is)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = clst_a(j)*cls_a_diff(is)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref cdst_a_diff(j) = cdst_a_diff(j) + sr*cds_a_diff(is)/sref - temp_diff3 = cdst_a(j)*cds_a_diff(is)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref + temp_diff2 = cdst_a(j)*cds_a_diff(is)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref cdv_lstrp_diff(j) = cdv_lstrp_diff(j) + sr*cdvsurf_diff(is)/ + sref - temp_diff3 = cdv_lstrp(j)*cdvsurf_diff(is)/sref - sr_diff = sr_diff + temp_diff3 - sref_diff = sref_diff - sr*temp_diff3/sref - temp_diff3 = cmsurf_diff(3, is)/(sref*bref) - cmstrp_diff(3, j) = cmstrp_diff(3, j) + sr*cr*temp_diff3 - temp_diff1 = cmstrp(3, j)*temp_diff3 - temp_diff2 = -(cmstrp(3, j)*sr*cr*temp_diff3/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff2 - bref_diff = bref_diff + sref*temp_diff2 + temp_diff2 = cdv_lstrp(j)*cdvsurf_diff(is)/sref + sr_diff = sr_diff + temp_diff2 + sref_diff = sref_diff - sr*temp_diff2/sref + temp_diff2 = cmsurf_diff(3, is)/(sref*bref) + cmstrp_diff(3, j) = cmstrp_diff(3, j) + sr*cr*temp_diff2 + temp_diff1 = cmstrp(3, j)*temp_diff2 + temp_diff3 = -(cmstrp(3, j)*sr*cr*temp_diff2/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff3 + bref_diff = bref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 - temp_diff3 = cmsurf_diff(2, is)/(sref*cref) - cmstrp_diff(2, j) = cmstrp_diff(2, j) + sr*cr*temp_diff3 - temp_diff1 = cmstrp(2, j)*temp_diff3 - temp_diff2 = -(cmstrp(2, j)*sr*cr*temp_diff3/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff2 - cref_diff = cref_diff + sref*temp_diff2 + temp_diff2 = cmsurf_diff(2, is)/(sref*cref) + cmstrp_diff(2, j) = cmstrp_diff(2, j) + sr*cr*temp_diff2 + temp_diff1 = cmstrp(2, j)*temp_diff2 + temp_diff3 = -(cmstrp(2, j)*sr*cr*temp_diff2/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff3 + cref_diff = cref_diff + sref*temp_diff3 sr_diff = sr_diff + cr*temp_diff1 cr_diff = cr_diff + sr*temp_diff1 temp_diff2 = cmsurf_diff(1, is)/(sref*bref) @@ -1953,6 +1950,9 @@ SUBROUTINE SFFORC_B() chord_diff(j) = chord_diff(j) + cr_diff + wstrip(j)*sr_diff wstrip_diff(j) = wstrip_diff(j) + chord(j)*sr_diff ENDDO + CALL POPREAL8(cr) + CALL POPREAL8(sr) + CALL POPINTEGER4(j) DO n=ncontrol,1,-1 DO l=3,1,-1 cms_d_diff(l, is, n) = 0.D0 @@ -1978,6 +1978,7 @@ SUBROUTINE SFFORC_B() cmsurf_diff(l, is) = 0.D0 cfsurf_diff(l, is) = 0.D0 ENDDO + CALL POPINTEGER4(l) clsurf_diff(is) = 0.D0 cysurf_diff(is) = 0.D0 cdsurf_diff(is) = 0.D0 @@ -2590,19 +2591,20 @@ SUBROUTINE SFFORC_B() IF (.NOT.ltrforce) THEN CALL PUSHCONTROL1B(0) ELSE + CALL PUSHINTEGER4(i) CALL PUSHREAL8ARRAY(f, 3) CALL PUSHREAL8ARRAY(g, 3) CALL PUSHREAL8ARRAY(wrot_u, 3) CALL PUSHREAL8ARRAY(fgam_u, 3*6) CALL PUSHREAL8ARRAY(veff_u, 3*6) CALL PUSHREAL8ARRAY(r, 3) - CALL PUSHREAL8ARRAY(vrot, 3) - CALL PUSHREAL8ARRAY(vrot_u, 3) CALL PUSHREAL8ARRAY(veff, 3) CALL PUSHREAL8ARRAY(fgam, 3) CALL PUSHREAL8ARRAY(f_u, 3*6) CALL PUSHREAL8ARRAY(rrot, 3) CALL PUSHREAL8ARRAY(fgam_d, 3*ndmax) + CALL PUSHREAL8ARRAY(vrot, 3) + CALL PUSHREAL8ARRAY(vrot_u, 3) C$FWD-OF II-LOOP C C----- Sum forces on trailing legs using velocity = (freestream + rotation) @@ -2837,24 +2839,36 @@ SUBROUTINE SFFORC_B() C R(2) = RC4(2) - RC4(2) C R(3) = RC4(3) - RC4(3) C--- Get rotational velocity at strip 1/4 chord reference point + CALL PUSHREAL8(rrot(1)) rrot(1) = rc4(1) - xyzref(1) + CALL PUSHREAL8(rrot(2)) rrot(2) = rc4(2) - xyzref(2) + CALL PUSHREAL8(rrot(3)) rrot(3) = rc4(3) - xyzref(3) C--- Onset velocity at strip c/4 = freestream + rotation CALL CROSS(rrot, wrot, vrot) + CALL PUSHREAL8(veff(1)) veff(1) = vinf(1) + vrot(1) + CALL PUSHREAL8(veff(2)) veff(2) = vinf(2) + vrot(2) + CALL PUSHREAL8(veff(3)) veff(3) = vinf(3) + vrot(3) veffmag = SQRT(veff(1)**2 + veff(2)**2 + veff(3)**2) C C------- set sensitivities to freestream,rotation components DO k=1,3 + CALL PUSHREAL8(veff_u(1, k)) veff_u(1, k) = 0. + CALL PUSHREAL8(veff_u(2, k)) veff_u(2, k) = 0. + CALL PUSHREAL8(veff_u(3, k)) veff_u(3, k) = 0. ENDDO + CALL PUSHREAL8(veff_u(1, 1)) veff_u(1, 1) = 1.0 + CALL PUSHREAL8(veff_u(2, 2)) veff_u(2, 2) = 1.0 + CALL PUSHREAL8(veff_u(3, 3)) veff_u(3, 3) = 1.0 DO k=4,6 CALL PUSHREAL8(wrot_u(1)) @@ -2866,8 +2880,11 @@ SUBROUTINE SFFORC_B() CALL PUSHREAL8(wrot_u(k-3)) wrot_u(k-3) = 1.0 CALL CROSS(rrot, wrot_u, vrot_u) + CALL PUSHREAL8(veff_u(1, k)) veff_u(1, k) = vrot_u(1) + CALL PUSHREAL8(veff_u(2, k)) veff_u(2, k) = vrot_u(2) + CALL PUSHREAL8(veff_u(3, k)) veff_u(3, k) = vrot_u(3) ENDDO DO n=1,numax @@ -2974,8 +2991,11 @@ SUBROUTINE SFFORC_B() END IF C C------ vector from chord c/4 reference point to case reference point XYZREF + CALL PUSHREAL8(r(1)) r(1) = rc4(1) - xyzref(1) + CALL PUSHREAL8(r(2)) r(2) = rc4(2) - xyzref(2) + CALL PUSHREAL8(r(3)) r(3) = rc4(3) - xyzref(3) C... Strip moments in body axes about the case moment reference point XYZREF C normalized by strip area and chord @@ -3113,12 +3133,15 @@ SUBROUTINE SFFORC_B() cfy_diff = cfy_diff - r(3)*temp_diff r_diff(3) = r_diff(3) - cfy*temp_diff cr_diff = cr_diff - (cfz*r(2)-cfy*r(3))*temp_diff/cr + CALL POPREAL8(r(3)) rc4_diff(3) = rc4_diff(3) + r_diff(3) xyzref_diff(3) = xyzref_diff(3) - r_diff(3) r_diff(3) = 0.D0 + CALL POPREAL8(r(2)) rc4_diff(2) = rc4_diff(2) + r_diff(2) xyzref_diff(2) = xyzref_diff(2) - r_diff(2) r_diff(2) = 0.D0 + CALL POPREAL8(r(1)) rc4_diff(1) = rc4_diff(1) + r_diff(1) xyzref_diff(1) = xyzref_diff(1) - r_diff(1) r_diff(1) = 0.D0 @@ -3329,10 +3352,13 @@ SUBROUTINE SFFORC_B() + veff_u(2, n)+veff(3)*veff_u(3, n))*temp_diff/veffmag ENDDO DO k=6,4,-1 + CALL POPREAL8(veff_u(3, k)) vrot_u_diff(3) = vrot_u_diff(3) + veff_u_diff(3, k) veff_u_diff(3, k) = 0.D0 + CALL POPREAL8(veff_u(2, k)) vrot_u_diff(2) = vrot_u_diff(2) + veff_u_diff(2, k) veff_u_diff(2, k) = 0.D0 + CALL POPREAL8(veff_u(1, k)) vrot_u_diff(1) = vrot_u_diff(1) + veff_u_diff(1, k) veff_u_diff(1, k) = 0.D0 DO ii1=1,3 @@ -3345,12 +3371,18 @@ SUBROUTINE SFFORC_B() CALL POPREAL8(wrot_u(2)) CALL POPREAL8(wrot_u(1)) ENDDO + CALL POPREAL8(veff_u(3, 3)) veff_u_diff(3, 3) = 0.D0 + CALL POPREAL8(veff_u(2, 2)) veff_u_diff(2, 2) = 0.D0 + CALL POPREAL8(veff_u(1, 1)) veff_u_diff(1, 1) = 0.D0 DO k=3,1,-1 + CALL POPREAL8(veff_u(3, k)) veff_u_diff(3, k) = 0.D0 + CALL POPREAL8(veff_u(2, k)) veff_u_diff(2, k) = 0.D0 + CALL POPREAL8(veff_u(1, k)) veff_u_diff(1, k) = 0.D0 ENDDO IF (veff(1)**2 + veff(2)**2 + veff(3)**2 .EQ. 0.D0) THEN @@ -3362,23 +3394,29 @@ SUBROUTINE SFFORC_B() veff_diff(1) = veff_diff(1) + 2*veff(1)*temp_diff veff_diff(2) = veff_diff(2) + 2*veff(2)*temp_diff veff_diff(3) = veff_diff(3) + 2*veff(3)*temp_diff + CALL POPREAL8(veff(3)) vinf_diff(3) = vinf_diff(3) + veff_diff(3) vrot_diff(3) = vrot_diff(3) + veff_diff(3) veff_diff(3) = 0.D0 + CALL POPREAL8(veff(2)) vinf_diff(2) = vinf_diff(2) + veff_diff(2) vrot_diff(2) = vrot_diff(2) + veff_diff(2) veff_diff(2) = 0.D0 + CALL POPREAL8(veff(1)) vinf_diff(1) = vinf_diff(1) + veff_diff(1) vrot_diff(1) = vrot_diff(1) + veff_diff(1) veff_diff(1) = 0.D0 CALL CROSS_B(rrot, rrot_diff, wrot, wrot_diff, vrot, vrot_diff + ) + CALL POPREAL8(rrot(3)) rc4_diff(3) = rc4_diff(3) + rrot_diff(3) xyzref_diff(3) = xyzref_diff(3) - rrot_diff(3) rrot_diff(3) = 0.D0 + CALL POPREAL8(rrot(2)) rc4_diff(2) = rc4_diff(2) + rrot_diff(2) xyzref_diff(2) = xyzref_diff(2) - rrot_diff(2) rrot_diff(2) = 0.D0 + CALL POPREAL8(rrot(1)) rc4_diff(1) = rc4_diff(1) + rrot_diff(1) xyzref_diff(1) = xyzref_diff(1) - rrot_diff(1) rrot_diff(1) = 0.D0 @@ -3393,19 +3431,22 @@ SUBROUTINE SFFORC_B() xte1_diff = 0.D0 xte2_diff = 0.D0 sr_diff = 0.D0 + CALL POPREAL8ARRAY(vrot_u, 3) + CALL POPREAL8ARRAY(vrot, 3) + CALL ADSTACK_STARTREPEAT() CALL POPREAL8ARRAY(fgam_d, 3*ndmax) CALL POPREAL8ARRAY(rrot, 3) CALL POPREAL8ARRAY(f_u, 3*6) CALL POPREAL8ARRAY(fgam, 3) CALL POPREAL8ARRAY(veff, 3) - CALL POPREAL8ARRAY(vrot_u, 3) - CALL POPREAL8ARRAY(vrot, 3) CALL POPREAL8ARRAY(r, 3) CALL POPREAL8ARRAY(veff_u, 3*6) CALL POPREAL8ARRAY(fgam_u, 3*6) CALL POPREAL8ARRAY(wrot_u, 3) CALL POPREAL8ARRAY(g, 3) CALL POPREAL8ARRAY(f, 3) + CALL ADSTACK_RESETREPEAT() + CALL ADSTACK_ENDREPEAT() C$BWD-OF II-LOOP DO ii=1,nvc_strp i = i1 + (ii-1) @@ -3486,6 +3527,7 @@ SUBROUTINE SFFORC_B() veff_u(k, k) = 1.0 ENDDO CALL PUSHREAL8ARRAY(wrot_u, 3) + CALL PUSHREAL8ARRAY(veff_u, 3*6) C$FWD-OF II-LOOP DO k=4,6 wrot_u(1) = 0. @@ -3694,7 +3736,11 @@ SUBROUTINE SFFORC_B() ENDDO CALL POPREAL8ARRAY(f, 3) CALL CROSS_B(veff, veff_diff, g, g_diff, f, f_diff) + CALL POPREAL8ARRAY(veff_u, 3*6) + CALL ADSTACK_STARTREPEAT() CALL POPREAL8ARRAY(wrot_u, 3) + CALL ADSTACK_RESETREPEAT() + CALL ADSTACK_ENDREPEAT() C$BWD-OF II-LOOP DO k=4,6 wrot_u(1) = 0. @@ -3713,6 +3759,7 @@ SUBROUTINE SFFORC_B() CALL CROSS_B(rrot, rrot_diff, wrot_u, wrot_u_diff, + vrot_u, vrot_u_diff) ENDDO + CALL POPREAL8ARRAY(wrot_u, 3) CALL POPREAL8ARRAY(veff_u, 3*6) C$BWD-OF II-LOOP DO k=1,3 @@ -3805,6 +3852,18 @@ SUBROUTINE SFFORC_B() END IF ENDDO ENDDO + CALL POPREAL8ARRAY(fgam_d, 3*ndmax) + CALL POPREAL8ARRAY(rrot, 3) + CALL POPREAL8ARRAY(f_u, 3*6) + CALL POPREAL8ARRAY(fgam, 3) + CALL POPREAL8ARRAY(veff, 3) + CALL POPREAL8ARRAY(r, 3) + CALL POPREAL8ARRAY(veff_u, 3*6) + CALL POPREAL8ARRAY(fgam_u, 3*6) + CALL POPREAL8ARRAY(wrot_u, 3) + CALL POPREAL8ARRAY(g, 3) + CALL POPREAL8ARRAY(f, 3) + CALL POPINTEGER4(i) END IF CALL POPREAL8ARRAY(veff_d, 3*ndmax) CALL POPREAL8ARRAY(fgam_d, 3*ndmax) @@ -3940,6 +3999,8 @@ SUBROUTINE SFFORC_B() fgam_d(2, n) = 2.0*gam_d(i, n)*f(2) + 2.0*gam(i)*f_d(2, n) fgam_d(3, n) = 2.0*gam_d(i, n)*f(3) + 2.0*gam(i)*f_d(3, n) ENDDO + CALL PUSHINTEGER4(n) + CALL PUSHINTEGER4(n) C C-------- vortex contribution to strip forces dcfx = fgam(1)/sr @@ -3951,6 +4012,9 @@ SUBROUTINE SFFORC_B() C-------- moments referred to strip c/4 pt., normalized by strip chord and area C C-------- accumulate strip spanloading = c*CN + CALL PUSHINTEGER4(n) + CALL PUSHINTEGER4(l) + CALL POPINTEGER4(l) C$BWD-OF II-LOOP DO n=1,ncontrol dcfx_d = fgam_d(1, n)/sr @@ -4013,6 +4077,7 @@ SUBROUTINE SFFORC_B() fgam_u_diff(2, n) = fgam_u_diff(2, n) + dcfy_u_diff/sr fgam_u_diff(1, n) = fgam_u_diff(1, n) + dcfx_u_diff/sr ENDDO + CALL POPINTEGER4(n) temp_diff = cmz_diff/cr dcfy_diff = r(1)*temp_diff r_diff(1) = r_diff(1) + dcfy*temp_diff @@ -4036,6 +4101,8 @@ SUBROUTINE SFFORC_B() + dcfy_diff/sr**2 - fgam(1)*dcfx_diff/sr**2 fgam_diff(2) = fgam_diff(2) + dcfy_diff/sr fgam_diff(1) = fgam_diff(1) + dcfx_diff/sr + CALL POPINTEGER4(n) + CALL POPINTEGER4(n) C$BWD-OF II-LOOP DO n=1,ncontrol gam_d_diff(i, n) = gam_d_diff(i, n) + f(3)*2.0*fgam_d_diff(3 @@ -4346,6 +4413,12 @@ SUBROUTINE SFFORC_B() wstrip_diff(j) = wstrip_diff(j) + chord(j)*sr_diff ENDDO alfa_diff = alfa_diff + COS(alfa)*sina_diff - SIN(alfa)*cosa_diff +C write(6,*) 'Strip J ',J +C write(6,*) 'UDRAG ',UDRAG +C write(6,*) 'ULIFT ',ULIFT,' ULMAG ',ULMAG +C write(6,3) 'ULIFT(1)_U ',(ULIFT_U(1,L),L=1,NUMAX) +C write(6,3) 'ULIFT(2)_U ',(ULIFT_U(2,L),L=1,NUMAX) +C write(6,3) 'ULIFT(3)_U ',(ULIFT_U(3,L),L=1,NUMAX) 3 FORMAT(a,6(2x,f8.5)) END @@ -4408,10 +4481,10 @@ SUBROUTINE BDFORC_B() REAL dir EXTERNAL GETSA REAL temp_diff - REAL(kind=avl_real) temp_diff0 + REAL(kind=8) temp_diff0 INTEGER ii1 REAL(kind=avl_real) temp_diff1 - INTEGER*4 branch + INTEGER branch INTEGER ii2 C C @@ -4641,54 +4714,54 @@ SUBROUTINE BDFORC_B() cdbdy_diff(ib) = cdbdy_diff(ib) + cdtot_diff DO ilseg=nl(ib)-1,1,-1 DO iu=6,1,-1 - temp_diff1 = 2.0*cmbdy_u_diff(3, iu)/(sref*bref) - mb_u_diff(3, iu) = mb_u_diff(3, iu) + temp_diff1 - temp_diff0 = -(mb_u(3, iu)*temp_diff1/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff0 - bref_diff = bref_diff + sref*temp_diff0 - temp_diff1 = 2.0*cmbdy_u_diff(2, iu)/(sref*cref) - mb_u_diff(2, iu) = mb_u_diff(2, iu) + temp_diff1 - temp_diff0 = -(mb_u(2, iu)*temp_diff1/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff0 - cref_diff = cref_diff + sref*temp_diff0 - temp_diff1 = 2.0*cmbdy_u_diff(1, iu)/(sref*bref) - mb_u_diff(1, iu) = mb_u_diff(1, iu) + temp_diff1 - temp_diff0 = -(mb_u(1, iu)*temp_diff1/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff0 - bref_diff = bref_diff + sref*temp_diff0 + temp_diff0 = 2.0*cmbdy_u_diff(3, iu)/(sref*bref) + mb_u_diff(3, iu) = mb_u_diff(3, iu) + temp_diff0 + temp_diff1 = -(mb_u(3, iu)*temp_diff0/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff1 + bref_diff = bref_diff + sref*temp_diff1 + temp_diff0 = 2.0*cmbdy_u_diff(2, iu)/(sref*cref) + mb_u_diff(2, iu) = mb_u_diff(2, iu) + temp_diff0 + temp_diff1 = -(mb_u(2, iu)*temp_diff0/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff1 + cref_diff = cref_diff + sref*temp_diff1 + temp_diff0 = 2.0*cmbdy_u_diff(1, iu)/(sref*bref) + mb_u_diff(1, iu) = mb_u_diff(1, iu) + temp_diff0 + temp_diff1 = -(mb_u(1, iu)*temp_diff0/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff1 + bref_diff = bref_diff + sref*temp_diff1 DO l=3,1,-1 - temp_diff1 = 2.0*cfbdy_u_diff(l, iu)/sref - fb_u_diff(l, iu) = fb_u_diff(l, iu) + temp_diff1 - sref_diff = sref_diff - fb_u(l, iu)*temp_diff1/sref + temp_diff0 = 2.0*cfbdy_u_diff(l, iu)/sref + fb_u_diff(l, iu) = fb_u_diff(l, iu) + temp_diff0 + sref_diff = sref_diff - fb_u(l, iu)*temp_diff0/sref ENDDO - temp_diff1 = 2.0*clbdy_u_diff(iu)/sref - fb_u_diff(3, iu) = fb_u_diff(3, iu) + cosa*temp_diff1 - cosa_diff = cosa_diff + fb_u(3, iu)*temp_diff1 - fb_u_diff(1, iu) = fb_u_diff(1, iu) - sina*temp_diff1 - sina_diff = sina_diff - fb_u(1, iu)*temp_diff1 + temp_diff0 = 2.0*clbdy_u_diff(iu)/sref + fb_u_diff(3, iu) = fb_u_diff(3, iu) + cosa*temp_diff0 + cosa_diff = cosa_diff + fb_u(3, iu)*temp_diff0 + fb_u_diff(1, iu) = fb_u_diff(1, iu) - sina*temp_diff0 + sina_diff = sina_diff - fb_u(1, iu)*temp_diff0 sref_diff = sref_diff - (fb_u(3, iu)*cosa-fb_u(1, iu)*sina)* - + temp_diff1/sref - temp_diff1 = 2.0*cybdy_u_diff(iu)/sref - fb_u_diff(2, iu) = fb_u_diff(2, iu) + temp_diff1 - sref_diff = sref_diff - fb_u(2, iu)*temp_diff1/sref - temp_diff1 = 2.0*cdbdy_u_diff(iu)/sref - fb_u_diff(1, iu) = fb_u_diff(1, iu) + cosa*temp_diff1 - cosa_diff = cosa_diff + fb_u(1, iu)*temp_diff1 - fb_u_diff(3, iu) = fb_u_diff(3, iu) + sina*temp_diff1 - sina_diff = sina_diff + fb_u(3, iu)*temp_diff1 + + temp_diff0/sref + temp_diff0 = 2.0*cybdy_u_diff(iu)/sref + fb_u_diff(2, iu) = fb_u_diff(2, iu) + temp_diff0 + sref_diff = sref_diff - fb_u(2, iu)*temp_diff0/sref + temp_diff0 = 2.0*cdbdy_u_diff(iu)/sref + fb_u_diff(1, iu) = fb_u_diff(1, iu) + cosa*temp_diff0 + cosa_diff = cosa_diff + fb_u(1, iu)*temp_diff0 + fb_u_diff(3, iu) = fb_u_diff(3, iu) + sina*temp_diff0 + sina_diff = sina_diff + fb_u(3, iu)*temp_diff0 sref_diff = sref_diff - (fb_u(1, iu)*cosa+fb_u(3, iu)*sina)* - + temp_diff1/sref + + temp_diff0/sref ENDDO - temp_diff1 = 2.0*cmbdy_diff(3, ib)/(sref*bref) - mb_diff(3) = mb_diff(3) + temp_diff1 - temp_diff0 = -(mb(3)*temp_diff1/(sref*bref)) - sref_diff = sref_diff + bref*temp_diff0 - bref_diff = bref_diff + sref*temp_diff0 - temp_diff1 = 2.0*cmbdy_diff(2, ib)/(sref*cref) - mb_diff(2) = mb_diff(2) + temp_diff1 - temp_diff0 = -(mb(2)*temp_diff1/(sref*cref)) - sref_diff = sref_diff + cref*temp_diff0 - cref_diff = cref_diff + sref*temp_diff0 + temp_diff0 = 2.0*cmbdy_diff(3, ib)/(sref*bref) + mb_diff(3) = mb_diff(3) + temp_diff0 + temp_diff1 = -(mb(3)*temp_diff0/(sref*bref)) + sref_diff = sref_diff + bref*temp_diff1 + bref_diff = bref_diff + sref*temp_diff1 + temp_diff0 = 2.0*cmbdy_diff(2, ib)/(sref*cref) + mb_diff(2) = mb_diff(2) + temp_diff0 + temp_diff1 = -(mb(2)*temp_diff0/(sref*cref)) + sref_diff = sref_diff + cref*temp_diff1 + cref_diff = cref_diff + sref*temp_diff1 temp_diff0 = 2.0*cmbdy_diff(1, ib)/(sref*bref) mb_diff(1) = mb_diff(1) + temp_diff0 temp_diff1 = -(mb(1)*temp_diff0/(sref*bref)) diff --git a/src/ad_src/reverse_ad_src/aic_b.f b/src/ad_src/reverse_ad_src/aic_b.f index f3cc4bc..7518b9a 100644 --- a/src/ad_src/reverse_ad_src/aic_b.f +++ b/src/ad_src/reverse_ad_src/aic_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of vvor in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: chordv rc rv1 rv2 zsym betm @@ -94,20 +94,20 @@ SUBROUTINE VVOR_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL vs_diff REAL ws REAL ws_diff - REAL(kind=avl_real) arg1 - REAL(kind=avl_real) arg1_diff - REAL(kind=avl_real) arg2 - REAL(kind=avl_real) arg2_diff - REAL(kind=avl_real) arg3 - REAL(kind=avl_real) arg3_diff - REAL(kind=avl_real) arg4 - REAL(kind=avl_real) arg4_diff + REAL(kind=8) arg1 + REAL(kind=8) arg1_diff + REAL(kind=8) arg2 + REAL(kind=8) arg2_diff + REAL(kind=8) arg3 + REAL(kind=8) arg3_diff + REAL(kind=8) arg4 + REAL(kind=8) arg4_diff REAL(kind=avl_real) temp REAL(kind=avl_real) temp0 REAL(kind=avl_real) temp_diff REAL(kind=avl_real) temp_diff0 REAL(kind=avl_real) temp_diff1 - INTEGER*4 branch + INTEGER branch REAL vrcorec REAL vrcorew REAL zsym @@ -437,7 +437,7 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, REAL temp_diff0 REAL temp_diff1 REAL temp_diff2 - INTEGER*4 branch + INTEGER branch INTEGER ad_to INTEGER ii1 INTEGER ii2 @@ -530,12 +530,12 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, CALL SRDVELC(rc(1, i), rc(2, i), rc(3, i), rl(1, l1), + arg1, arg2, rl(1, l2), arg3, arg4, betm, + rcore, vsrc, vdbl) - CALL PUSHCONTROL2B(0) + CALL PUSHCONTROL2B(2) ELSE CALL PUSHCONTROL2B(1) END IF ELSE - CALL PUSHCONTROL2B(2) + CALL PUSHCONTROL2B(0) END IF ENDDO ENDDO @@ -573,10 +573,56 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, rcore_diff = 0.D0 DO i=nc,1,-1 CALL POPCONTROL2B(branch) - IF (branch .EQ. 0) THEN + IF (branch .NE. 0) THEN + IF (branch .NE. 1) THEN + DO iu=nu,1,-1 + DO k=3,1,-1 + temp_diff = fysym*fzsym*wc_u_diff(k, i, iu) + vsrc_diff(k) = vsrc_diff(k) + src_u(l, iu)*temp_diff + src_u_diff(l, iu) = src_u_diff(l, iu) + vsrc(k)* + + temp_diff + vdbl_diff(k, 1) = vdbl_diff(k, 1) + dbl_u(1, l, iu)* + + temp_diff + dbl_u_diff(1, l, iu) = dbl_u_diff(1, l, iu) + vdbl(k + + , 1)*temp_diff + vdbl_diff(k, 2) = vdbl_diff(k, 2) - dbl_u(2, l, iu)* + + temp_diff + dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) - vdbl(k + + , 2)*temp_diff + vdbl_diff(k, 3) = vdbl_diff(k, 3) - dbl_u(3, l, iu)* + + temp_diff + dbl_u_diff(3, l, iu) = dbl_u_diff(3, l, iu) - vdbl(k + + , 3)*temp_diff + ENDDO + ENDDO + arg1 = yoff - rl(2, l1) + arg2 = zoff - rl(3, l1) + arg3 = yoff - rl(2, l2) + arg4 = zoff - rl(3, l2) + CALL POPREAL8ARRAY(vsrc, 3) + CALL POPREAL8ARRAY(vdbl, 3**2) + arg1_diff = 0.D0 + arg2_diff = 0.D0 + arg3_diff = 0.D0 + arg4_diff = 0.D0 + CALL SRDVELC_B(rc(1, i), rc_diff(1, i), rc(2, i), + + rc_diff(2, i), rc(3, i), rc_diff(3, i), + + rl(1, l1), rl_diff(1, l1), arg1, + + arg1_diff, arg2, arg2_diff, rl(1, l2), + + rl_diff(1, l2), arg3, arg3_diff, arg4, + + arg4_diff, betm, betm_diff, rcore, + + rcore_diff, vsrc, vsrc_diff, vdbl, + + vdbl_diff) + zoff_diff = zoff_diff + arg4_diff + arg2_diff + rl_diff(3, l2) = rl_diff(3, l2) - arg4_diff + yoff_diff = yoff_diff + arg3_diff + arg1_diff + rl_diff(2, l2) = rl_diff(2, l2) - arg3_diff + rl_diff(3, l1) = rl_diff(3, l1) - arg2_diff + rl_diff(2, l1) = rl_diff(2, l1) - arg1_diff + END IF DO iu=nu,1,-1 DO k=3,1,-1 - temp_diff = fysym*fzsym*wc_u_diff(k, i, iu) + temp_diff = fzsym*wc_u_diff(k, i, iu) vsrc_diff(k) = vsrc_diff(k) + src_u(l, iu)*temp_diff src_u_diff(l, iu) = src_u_diff(l, iu) + vsrc(k)* + temp_diff @@ -584,9 +630,9 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, + temp_diff dbl_u_diff(1, l, iu) = dbl_u_diff(1, l, iu) + vdbl(k, + 1)*temp_diff - vdbl_diff(k, 2) = vdbl_diff(k, 2) - dbl_u(2, l, iu)* + vdbl_diff(k, 2) = vdbl_diff(k, 2) + dbl_u(2, l, iu)* + temp_diff - dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) - vdbl(k, + dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) + vdbl(k, + 2)*temp_diff vdbl_diff(k, 3) = vdbl_diff(k, 3) - dbl_u(3, l, iu)* + temp_diff @@ -594,69 +640,25 @@ SUBROUTINE VSRD_B(betm, betm_diff, iysym, ysym, ysym_diff, izsym, + 3)*temp_diff ENDDO ENDDO - arg1 = yoff - rl(2, l1) - arg2 = zoff - rl(3, l1) - arg3 = yoff - rl(2, l2) - arg4 = zoff - rl(3, l2) + arg1 = zoff - rl(3, l1) + arg2 = zoff - rl(3, l2) CALL POPREAL8ARRAY(vsrc, 3) CALL POPREAL8ARRAY(vdbl, 3**2) arg1_diff = 0.D0 arg2_diff = 0.D0 - arg3_diff = 0.D0 - arg4_diff = 0.D0 CALL SRDVELC_B(rc(1, i), rc_diff(1, i), rc(2, i), rc_diff( + 2, i), rc(3, i), rc_diff(3, i), rl(1, l1), - + rl_diff(1, l1), arg1, arg1_diff, arg2, - + arg2_diff, rl(1, l2), rl_diff(1, l2), arg3 - + , arg3_diff, arg4, arg4_diff, betm, - + betm_diff, rcore, rcore_diff, vsrc, - + vsrc_diff, vdbl, vdbl_diff) - zoff_diff = zoff_diff + arg4_diff + arg2_diff - rl_diff(3, l2) = rl_diff(3, l2) - arg4_diff - yoff_diff = yoff_diff + arg3_diff + arg1_diff - rl_diff(2, l2) = rl_diff(2, l2) - arg3_diff - rl_diff(3, l1) = rl_diff(3, l1) - arg2_diff - rl_diff(2, l1) = rl_diff(2, l1) - arg1_diff - ELSE IF (branch .NE. 1) THEN - GOTO 100 + + rl_diff(1, l1), rl(2, l1), rl_diff(2, l1), + + arg1, arg1_diff, rl(1, l2), rl_diff(1, l2) + + , rl(2, l2), rl_diff(2, l2), arg2, + + arg2_diff, betm, betm_diff, rcore, + + rcore_diff, vsrc, vsrc_diff, vdbl, + + vdbl_diff) + zoff_diff = zoff_diff + arg2_diff + arg1_diff + rl_diff(3, l2) = rl_diff(3, l2) - arg2_diff + rl_diff(3, l1) = rl_diff(3, l1) - arg1_diff END IF - DO iu=nu,1,-1 - DO k=3,1,-1 - temp_diff = fzsym*wc_u_diff(k, i, iu) - vsrc_diff(k) = vsrc_diff(k) + src_u(l, iu)*temp_diff - src_u_diff(l, iu) = src_u_diff(l, iu) + vsrc(k)* - + temp_diff - vdbl_diff(k, 1) = vdbl_diff(k, 1) + dbl_u(1, l, iu)* - + temp_diff - dbl_u_diff(1, l, iu) = dbl_u_diff(1, l, iu) + vdbl(k, 1) - + *temp_diff - vdbl_diff(k, 2) = vdbl_diff(k, 2) + dbl_u(2, l, iu)* - + temp_diff - dbl_u_diff(2, l, iu) = dbl_u_diff(2, l, iu) + vdbl(k, 2) - + *temp_diff - vdbl_diff(k, 3) = vdbl_diff(k, 3) - dbl_u(3, l, iu)* - + temp_diff - dbl_u_diff(3, l, iu) = dbl_u_diff(3, l, iu) - vdbl(k, 3) - + *temp_diff - ENDDO - ENDDO - arg1 = zoff - rl(3, l1) - arg2 = zoff - rl(3, l2) - CALL POPREAL8ARRAY(vsrc, 3) - CALL POPREAL8ARRAY(vdbl, 3**2) - arg1_diff = 0.D0 - arg2_diff = 0.D0 - CALL SRDVELC_B(rc(1, i), rc_diff(1, i), rc(2, i), rc_diff(2 - + , i), rc(3, i), rc_diff(3, i), rl(1, l1), - + rl_diff(1, l1), rl(2, l1), rl_diff(2, l1), - + arg1, arg1_diff, rl(1, l2), rl_diff(1, l2), - + rl(2, l2), rl_diff(2, l2), arg2, arg2_diff, - + betm, betm_diff, rcore, rcore_diff, vsrc, - + vsrc_diff, vdbl, vdbl_diff) - zoff_diff = zoff_diff + arg2_diff + arg1_diff - rl_diff(3, l2) = rl_diff(3, l2) - arg2_diff - rl_diff(3, l1) = rl_diff(3, l1) - arg1_diff - 100 CALL POPCONTROL1B(branch) + CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN DO iu=nu,1,-1 DO k=3,1,-1 @@ -827,7 +829,7 @@ SUBROUTINE SRDSET_B(betm, betm_diff, xyzref, xyzref_diff, iysym, REAL DOT REAL temp_diff INTEGER ii1 - INTEGER*4 branch + INTEGER branch INTEGER ad_to INTEGER nbody REAL pi @@ -1196,7 +1198,7 @@ SUBROUTINE VORVELC_B(x, x_diff, y, y_diff, z, z_diff, lbound, x1, REAL temp_diff4 INTEGER ii1 REAL temp_diff5 - INTEGER*4 branch + INTEGER branch REAL y1 REAL y1_diff REAL y2 diff --git a/src/ad_src/reverse_ad_src/amake_b.f b/src/ad_src/reverse_ad_src/amake_b.f index dbb85ae..abb90cb 100644 --- a/src/ad_src/reverse_ad_src/amake_b.f +++ b/src/ad_src/reverse_ad_src/amake_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of update_surfaces in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: rle chord rle1 chord1 rle2 @@ -21,7 +21,6 @@ SUBROUTINE UPDATE_SURFACES_B() use avl_heap_inc use avl_heap_diff_inc -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER ii @@ -31,7 +30,7 @@ SUBROUTINE UPDATE_SURFACES_B() EXTERNAL AVLHEAP_INIT EXTERNAL AVLHEAP_DIFF_INIT INTEGER ii1 - INTEGER*4 branch + INTEGER branch INTEGER ii2 INTEGER ii3 nstrip = 0 @@ -49,6 +48,7 @@ SUBROUTINE UPDATE_SURFACES_B() C the iterations of this loop are not independent because we count C up the size information as we make each surface DO ii=1,nsurf-nsurfdupl + IF (lverbose) WRITE(*, *) 'Updating surface ', isurf IF (lsurfmsh(isurf)) THEN CALL PUSHREAL8ARRAY(dxv, nvmax) CALL PUSHREAL8ARRAY(rc, 3*nvmax) @@ -79,6 +79,7 @@ SUBROUTINE UPDATE_SURFACES_B() CALL PUSHCONTROL1B(1) END IF IF (ldupl(isurf)) THEN + IF (lverbose) WRITE(*, *) ' reduplicating ', isurf CALL PUSHREAL8ARRAY(vrefl, nsmax*ndmax) CALL PUSHINTEGER4ARRAY(nvstrp, nsmax) CALL PUSHINTEGER4ARRAY(ijfrst, nsmax) @@ -412,7 +413,7 @@ SUBROUTINE MAKESURF_B(isurf) INTEGER ad_to0 INTEGER ad_count INTEGER i - INTEGER*4 branch + INTEGER branch INTEGER ii3 INTEGER ii2 INTEGER ad_to1 @@ -458,10 +459,10 @@ SUBROUTINE MAKESURF_B(isurf) dy = xyzles(2, isec, isurf) - xyzles(2, isec-1, isurf) dz = xyzles(3, isec, isurf) - xyzles(3, isec-1, isurf) yzlen(isec) = yzlen(isec-1) + SQRT(dy*dy + dz*dz) -C we can not rely on the original condition becuase NVS(ISURF) is filled -C and we may want to rebuild the surface later ENDDO CALL PUSHINTEGER4(isec - 1) +C we can not rely on the original condition becuase NVS(ISURF) is filled +C and we may want to rebuild the surface later C IF (nvs(isurf) .EQ. 0 .OR. (lsurfspacing(isurf) .EQV. .false.)) + THEN @@ -830,7 +831,7 @@ SUBROUTINE MAKESURF_B(isurf) C C C - CALL PUSHCONTROL1B(0) + CALL PUSHCONTROL1B(1) ELSE C----------- control variable # N is active here CALL PUSHREAL8(gainda(n)) @@ -901,7 +902,7 @@ SUBROUTINE MAKESURF_B(isurf) vmod = SQRT(vsq) C C - CALL PUSHCONTROL1B(1) + CALL PUSHCONTROL1B(0) END IF ENDDO C--- If the min drag is zero flag the strip as no-viscous data @@ -1248,16 +1249,6 @@ SUBROUTINE MAKESURF_B(isurf) DO n=ncontrol,1,-1 CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN - vhinge_diff(3, idx_strip, n) = 0.D0 - vhinge_diff(2, idx_strip, n) = 0.D0 - vhinge_diff(1, idx_strip, n) = 0.D0 - CALL POPREAL8(xted(n)) - xted_diff(n) = 0.D0 - CALL POPREAL8(xled(n)) - xled_diff(n) = 0.D0 - CALL POPREAL8(gainda(n)) - gainda_diff(n) = 0.D0 - ELSE vhz_diff = vhinge_diff(3, idx_strip, n)/vmod vmod_diff = -(vhz*vhinge_diff(3, idx_strip, n)/vmod**2 + ) - vhy*vhinge_diff(2, idx_strip, n)/vmod**2 - vhx* @@ -1366,6 +1357,16 @@ SUBROUTINE MAKESURF_B(isurf) chordl_diff = chordl_diff + (1.0-fc)*temp_diff1 CALL POPREAL8(gainda(n)) gainda_diff(n) = 0.D0 + ELSE + vhinge_diff(3, idx_strip, n) = 0.D0 + vhinge_diff(2, idx_strip, n) = 0.D0 + vhinge_diff(1, idx_strip, n) = 0.D0 + CALL POPREAL8(xted(n)) + xted_diff(n) = 0.D0 + CALL POPREAL8(xled(n)) + xled_diff(n) = 0.D0 + CALL POPREAL8(gainda(n)) + gainda_diff(n) = 0.D0 END IF CALL POPINTEGER4(icr) CALL POPINTEGER4(icl) @@ -2337,16 +2338,18 @@ SUBROUTINE MAKESURF_MESH_B(isurf) REAL temp_diff REAL temp_diff0 REAL temp_diff1 - REAL(kind=avl_real) temp2 - REAL(kind=avl_real) temp_diff2 - REAL(kind=avl_real) temp3 - REAL(kind=avl_real) temp_diff3 - REAL(kind=avl_real) temp4 - REAL(kind=avl_real) temp_diff4 + REAL(kind=8) temp2 + REAL(kind=8) temp_diff2 + REAL(kind=8) temp3 + REAL(kind=8) temp_diff3 + REAL(kind=8) temp4 + REAL(kind=8) temp_diff4 + REAL(kind=avl_real) temp5 + REAL(kind=avl_real) temp_diff5 INTEGER ad_to INTEGER ad_to0 INTEGER ad_to1 - INTEGER*4 branch + INTEGER branch INTEGER ad_to2 INTEGER ad_to3 INTEGER ad_to4 @@ -2380,6 +2383,7 @@ SUBROUTINE MAKESURF_MESH_B(isurf) idx_strip = jfrst(isurf) C Number of strips/sections in surface C +C Apply the scaling and translations to the mesh as a whole C C DO idx_y=1,ny @@ -2395,6 +2399,8 @@ SUBROUTINE MAKESURF_MESH_B(isurf) CALL PUSHINTEGER4(idx_x - 1) ENDDO CALL PUSHINTEGER4(idx_y - 1) +C Setup the strips +C Set spanwise elements to 0 C C C @@ -2477,6 +2483,9 @@ SUBROUTINE MAKESURF_MESH_B(isurf) ENDDO CALL PUSHINTEGER4(iscon - 1) ENDDO +C We need to determine which dvs belong to this strip +C and setup the chord projection gains +C Bring over the routine for this from makesurf but setup for strips C DO n=1,ndesign chsinl_g(n) = 0. @@ -2506,6 +2515,11 @@ SUBROUTINE MAKESURF_MESH_B(isurf) ENDDO CALL PUSHINTEGER4(isdes - 1) ENDDO +C Set the strip geometry data +C Note these computations assume the mesh is not necessarily planar +C ultimately if/when we flatten the mesh into a planar one we will want +C to use the leading edge positions and chords from the original input mesh +C Strip left side C C C @@ -2541,9 +2555,9 @@ SUBROUTINE MAKESURF_MESH_B(isurf) CALL PUSHREAL8(rle(idx_dim, idx_strip)) rle(idx_dim, idx_strip) = (rle1(idx_dim, idx_strip)+rle2( + idx_dim, idx_strip))/2. + ENDDO C The strips are not necessarily linear chord wise but by definition the chord value is C so we can interpolate - ENDDO C Strip geometric incidence angle at the mid-point C This is strip incidence angle is computed from the LE and TE points C of the given geometry and is completely independent of AINC @@ -2598,9 +2612,9 @@ SUBROUTINE MAKESURF_MESH_B(isurf) chsin_g = (1.0-fc)*chsinl_g(n) + fc*chsinr_g(n) CALL PUSHREAL8(chcos_g) chcos_g = (1.0-fc)*chcosl_g(n) + fc*chcosr_g(n) + ENDDO C We have to now setup any control surfaces we defined for this strip C Bring over the routine for this from makesurf but modified for a strip - ENDDO C DO n=1,ncontrol CALL PUSHINTEGER4(icl) @@ -2620,7 +2634,7 @@ SUBROUTINE MAKESURF_MESH_B(isurf) C C C - CALL PUSHCONTROL1B(0) + CALL PUSHCONTROL1B(1) ELSE C control variable # N is active here C SAB Note: This interpolation ensures that the hinge line is @@ -2694,9 +2708,10 @@ SUBROUTINE MAKESURF_MESH_B(isurf) vmod = SQRT(vsq) C C - CALL PUSHCONTROL1B(1) + CALL PUSHCONTROL1B(0) END IF ENDDO +C If the min drag is zero flag the strip as no-viscous data C Set the panel (vortex) geometry data C Accumulate the strip element indicies and start counting vorticies C @@ -2880,13 +2895,13 @@ SUBROUTINE MAKESURF_MESH_B(isurf) CALL PUSHREAL8(slopel) CALL AKIMA(xasec(1, iptl, isurf), sasec(1, iptl, isurf), nsl + , arg1, slopel, dsdx) -C Alternative for nonlinear sections per Hal Youngren -C SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER -C The original line is valid for interpolation over a strip arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL PUSHREAL8(sloper) CALL AKIMA(xasec(1, iptr, isurf), sasec(1, iptr, isurf), nsr + , arg1, sloper, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEC(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip C C Camber slope at vortex mid-point C @@ -2894,13 +2909,13 @@ SUBROUTINE MAKESURF_MESH_B(isurf) CALL PUSHREAL8(slopel) CALL AKIMA(xasec(1, iptl, isurf), sasec(1, iptl, isurf), nsl + , arg1, slopel, dsdx) -C Alternative for nonlinear sections per Hal Youngren -C SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER -C The original line is valid for interpolation over a strip arg1 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL PUSHREAL8(sloper) CALL AKIMA(xasec(1, iptr, isurf), sasec(1, iptr, isurf), nsr + , arg1, sloper, dsdx) +C Alternative for nonlinear sections per Hal Youngren +C SLOPEV(idx_vor) = (1.-fc)*SLOPEL + fc*SLOPER +C The original line is valid for interpolation over a strip C C Associate the panel with strip chord and component C @@ -2945,6 +2960,7 @@ SUBROUTINE MAKESURF_MESH_B(isurf) CALL PUSHCONTROL1B(1) END IF ENDDO +C TE control point used only if surface sheds a wake C Use the cross sections to generate the OML C nodal grid associated with vortex strip (aft-panel nodes) C NOTE: airfoil in plane of wing, but not rotated perpendicular to dihedral; @@ -2982,12 +2998,10 @@ SUBROUTINE MAKESURF_MESH_B(isurf) C CALL PUSHINTEGER4(idx_vor) idx_vor = idx_vor + 1 -C End vortex loop ENDDO +C End vortex loop CALL PUSHINTEGER4(idx_strip) idx_strip = idx_strip + 1 -C End strip loop -C Compute the wetted area and cave from the true mesh ENDDO mesh_surf_diff = 0.D0 chcosl_g_diff = 0.D0 @@ -3038,41 +3052,40 @@ SUBROUTINE MAKESURF_MESH_B(isurf) ELSE fracle_diff = 0.D0 END IF - temp4 = chord(idx_strip)/dxv(idx_vor) - temp3 = xted(n)/chord(idx_strip) - temp_diff3 = temp4*fracte_diff/chord(idx_strip) - xpt_diff = -(temp4*fracte_diff) - temp_diff4 = (temp3-xpt)*fracte_diff/dxv(idx_vor) - chord_diff(idx_strip) = chord_diff(idx_strip) + temp_diff4 - + - temp3*temp_diff3 - dxv_diff(idx_vor) = dxv_diff(idx_vor) - temp4*temp_diff4 - xted_diff(n) = xted_diff(n) + temp_diff3 - temp4 = chord(idx_strip)/dxv(idx_vor) - temp3 = xled(n)/chord(idx_strip) - temp_diff3 = temp4*fracle_diff/chord(idx_strip) - xpt_diff = xpt_diff - temp4*fracle_diff - temp_diff4 = (temp3-xpt)*fracle_diff/dxv(idx_vor) - chord_diff(idx_strip) = chord_diff(idx_strip) + temp_diff4 - dxv_diff(idx_vor) = dxv_diff(idx_vor) - temp4*temp_diff4 - xled_diff(n) = xled_diff(n) + temp_diff3 + temp5 = chord(idx_strip)/dxv(idx_vor) + temp4 = xted(n)/chord(idx_strip) + temp_diff4 = temp5*fracte_diff/chord(idx_strip) + xpt_diff = -(temp5*fracte_diff) + temp_diff5 = (temp4-xpt)*fracte_diff/dxv(idx_vor) + chord_diff(idx_strip) = chord_diff(idx_strip) + temp_diff5 + + - temp4*temp_diff4 + dxv_diff(idx_vor) = dxv_diff(idx_vor) - temp5*temp_diff5 + xted_diff(n) = xted_diff(n) + temp_diff4 + temp5 = chord(idx_strip)/dxv(idx_vor) + temp4 = xled(n)/chord(idx_strip) + temp_diff4 = temp5*fracle_diff/chord(idx_strip) + xpt_diff = xpt_diff - temp5*fracle_diff + temp_diff5 = (temp4-xpt)*fracle_diff/dxv(idx_vor) + chord_diff(idx_strip) = chord_diff(idx_strip) + temp_diff5 + + - temp4*temp_diff4 + dxv_diff(idx_vor) = dxv_diff(idx_vor) - temp5*temp_diff5 + xled_diff(n) = xled_diff(n) + temp_diff4 temp_diff4 = xpt_diff/chord(idx_strip) - chord_diff(idx_strip) = chord_diff(idx_strip) - temp3* - + temp_diff3 - ((mesh_surf(1, idx_node)+mesh_surf(1, - + idx_node_yp1))/2-rle(1, idx_strip))*temp_diff4/chord( - + idx_strip) mesh_surf_diff(1, idx_node) = mesh_surf_diff(1, idx_node) + + temp_diff4/2 mesh_surf_diff(1, idx_node_yp1) = mesh_surf_diff(1, + idx_node_yp1) + temp_diff4/2 rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - + temp_diff4 + chord_diff(idx_strip) = chord_diff(idx_strip) - (( + + mesh_surf(1, idx_node)+mesh_surf(1, idx_node_yp1))/2-rle + + (1, idx_strip))*temp_diff4/chord(idx_strip) ENDDO temp_diff3 = fc*slopev_diff(idx_vor)/chord(idx_strip) - temp_diff4 = (1.-fc)*slopev_diff(idx_vor)/chord(idx_strip) chord_diff(idx_strip) = chord_diff(idx_strip) + chordv_diff( - + idx_vor) - chordr*sloper*temp_diff3/chord(idx_strip) - - + chordl*slopel*temp_diff4/chord(idx_strip) + + idx_vor) - chordr*sloper*temp_diff3/chord(idx_strip) chordv_diff(idx_vor) = 0.D0 + temp_diff4 = (1.-fc)*slopev_diff(idx_vor)/chord(idx_strip) slopev_diff(idx_vor) = 0.D0 chordr_diff = chordr_diff + sloper*temp_diff3 sloper_diff = chordr*temp_diff3 @@ -3085,11 +3098,12 @@ SUBROUTINE MAKESURF_MESH_B(isurf) + isurf), sasec(1, iptr, isurf), sasec_diff(1, + iptr, isurf), nsr, arg1, arg1_diff, sloper, + sloper_diff, dsdx) - temp_diff4 = arg1_diff/chord(idx_strip) - rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp_diff4 - rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 - chord_diff(idx_strip) = chord_diff(idx_strip) - (rv(1, - + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + temp_diff5 = arg1_diff/chord(idx_strip) + chord_diff(idx_strip) = chord_diff(idx_strip) - chordl* + + slopel*temp_diff4/chord(idx_strip) - (rv(1, idx_vor)-rle(1 + + , idx_strip))*temp_diff5/chord(idx_strip) + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp_diff5 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff5 arg1 = (rv(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL POPREAL8(slopel) arg1_diff = 0.D0 @@ -3097,19 +3111,17 @@ SUBROUTINE MAKESURF_MESH_B(isurf) + isurf), sasec(1, iptl, isurf), sasec_diff(1, + iptl, isurf), nsl, arg1, arg1_diff, slopel, + slopel_diff, dsdx) - temp_diff4 = arg1_diff/chord(idx_strip) - rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp_diff4 - rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 - chord_diff(idx_strip) = chord_diff(idx_strip) - (rv(1, - + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + temp_diff5 = arg1_diff/chord(idx_strip) + rv_diff(1, idx_vor) = rv_diff(1, idx_vor) + temp_diff5 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff5 temp_diff4 = (1.-fc)*slopec_diff(idx_vor)/chord(idx_strip) temp_diff3 = fc*slopec_diff(idx_vor)/chord(idx_strip) + chord_diff(idx_strip) = chord_diff(idx_strip) - (rv(1, + + idx_vor)-rle(1, idx_strip))*temp_diff5/chord(idx_strip) - + + chordr*sloper*temp_diff3/chord(idx_strip) slopec_diff(idx_vor) = 0.D0 chordr_diff = chordr_diff + sloper*temp_diff3 sloper_diff = chordr*temp_diff3 - chord_diff(idx_strip) = chord_diff(idx_strip) - chordr* - + sloper*temp_diff3/chord(idx_strip) - chordl*slopel* - + temp_diff4/chord(idx_strip) chordl_diff = chordl_diff + slopel*temp_diff4 slopel_diff = chordl*temp_diff4 arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) @@ -3119,11 +3131,12 @@ SUBROUTINE MAKESURF_MESH_B(isurf) + isurf), sasec(1, iptr, isurf), sasec_diff(1, + iptr, isurf), nsr, arg1, arg1_diff, sloper, + sloper_diff, dsdx) - temp_diff4 = arg1_diff/chord(idx_strip) - rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + temp_diff4 - rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 - chord_diff(idx_strip) = chord_diff(idx_strip) - (rc(1, - + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + temp_diff5 = arg1_diff/chord(idx_strip) + chord_diff(idx_strip) = chord_diff(idx_strip) - chordl* + + slopel*temp_diff4/chord(idx_strip) - (rc(1, idx_vor)-rle(1 + + , idx_strip))*temp_diff5/chord(idx_strip) + rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + temp_diff5 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff5 arg1 = (rc(1, idx_vor)-rle(1, idx_strip))/chord(idx_strip) CALL POPREAL8(slopel) arg1_diff = 0.D0 @@ -3131,11 +3144,11 @@ SUBROUTINE MAKESURF_MESH_B(isurf) + isurf), sasec(1, iptl, isurf), sasec_diff(1, + iptl, isurf), nsl, arg1, arg1_diff, slopel, + slopel_diff, dsdx) - temp_diff4 = arg1_diff/chord(idx_strip) - rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + temp_diff4 - rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff4 + temp_diff5 = arg1_diff/chord(idx_strip) + rc_diff(1, idx_vor) = rc_diff(1, idx_vor) + temp_diff5 + rle_diff(1, idx_strip) = rle_diff(1, idx_strip) - temp_diff5 chord_diff(idx_strip) = chord_diff(idx_strip) - (rc(1, - + idx_vor)-rle(1, idx_strip))*temp_diff4/chord(idx_strip) + + idx_vor)-rle(1, idx_strip))*temp_diff5/chord(idx_strip) CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN rv_diff(3, idx_vor) = rv_diff(3, idx_vor) + rs_diff(3, @@ -3561,15 +3574,6 @@ SUBROUTINE MAKESURF_MESH_B(isurf) DO n=ncontrol,1,-1 CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN - vhinge_diff(3, idx_strip, n) = 0.D0 - vhinge_diff(2, idx_strip, n) = 0.D0 - vhinge_diff(1, idx_strip, n) = 0.D0 - CALL POPREAL8(xted(n)) - xted_diff(n) = 0.D0 - CALL POPREAL8(xled(n)) - xled_diff(n) = 0.D0 - CALL POPREAL8(gainda(n)) - ELSE vhz_diff = vhinge_diff(3, idx_strip, n)/vmod vmod_diff = -(vhz*vhinge_diff(3, idx_strip, n)/vmod**2) - + vhy*vhinge_diff(2, idx_strip, n)/vmod**2 - vhx* @@ -3674,6 +3678,15 @@ SUBROUTINE MAKESURF_MESH_B(isurf) chordr_diff = chordr_diff + fc*xhinged(icr, iptr, isurf)* + xhd_diff CALL POPREAL8(gainda(n)) + ELSE + vhinge_diff(3, idx_strip, n) = 0.D0 + vhinge_diff(2, idx_strip, n) = 0.D0 + vhinge_diff(1, idx_strip, n) = 0.D0 + CALL POPREAL8(xted(n)) + xted_diff(n) = 0.D0 + CALL POPREAL8(xled(n)) + xled_diff(n) = 0.D0 + CALL POPREAL8(gainda(n)) END IF CALL POPINTEGER4(icr) CALL POPINTEGER4(icl) @@ -4023,7 +4036,7 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) REAL(kind=avl_real) tmp_diff25 INTEGER ad_count INTEGER i - INTEGER*4 branch + INTEGER branch INTEGER ad_to INTEGER ad_to0 INTEGER ad_to1 @@ -4110,10 +4123,10 @@ SUBROUTINE SDUPL_B(nn, ypt, msg) vrefl(jji, n) = tmp10 C C -C IJFRST(JJI) = NVOR + 1 -C IJFRST(JJI) = IJFRST(NSTRIP - 1) + NVC(NNI) ENDDO CALL PUSHINTEGER4(n - 1) +C IJFRST(JJI) = NVOR + 1 +C IJFRST(JJI) = IJFRST(NSTRIP - 1) + NVC(NNI) C C--- The defined section for image strip is flagged with (-) ijfrst(jji) = ijfrst(jji-1) + nvstrp(jji-1) @@ -4521,10 +4534,11 @@ SUBROUTINE ENCALC_B() REAL(kind=avl_real) temp1 REAL(kind=avl_real) temp_diff2 REAL(kind=avl_real) temp_diff3 - REAL temp_diff4 + REAL(kind=8) temp_diff4 + REAL temp_diff5 INTEGER ad_count INTEGER i0 - INTEGER*4 branch + INTEGER branch INTEGER ad_to INTEGER ii1 INTEGER ii3 @@ -4552,6 +4566,7 @@ SUBROUTINE ENCALC_B() dchstrip = 0.0 CALL PUSHINTEGER4(i) ad_count = 1 +C compute the spanwise unit vector for Vperp def searchsaxfr:DO i=ijfrst(j),ijfrst(j)+(nvstrp(j)-1) dchstrip = dchstrip + dxstrpv(i) IF (dchstrip .GE. chord(j)*saxfr) THEN @@ -5049,14 +5064,14 @@ SUBROUTINE ENCALC_B() END IF CALL POPREAL8(emag) IF (ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 .EQ. 0.D0) THEN - temp_diff4 = 0.D0 + temp_diff5 = 0.D0 ELSE - temp_diff4 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + temp_diff5 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + 3)**2)) END IF - ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff4 - ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff4 - ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff4 + ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff5 + ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff5 + ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff5 CALL POPREAL8ARRAY(ecxb, 3) CALL CROSS_B(ec, ec_diff, eb, eb_diff, ecxb, ecxb_diff) n = 0 @@ -5074,33 +5089,33 @@ SUBROUTINE ENCALC_B() ec_diff(1) = 0.D0 ELSE CALL POPREAL8(ec(3)) - temp_diff4 = ec_msh(3)*ec_diff(3) + temp_diff5 = ec_msh(3)*ec_diff(3) temp_diff1 = -((1-cosc)*ec_msh(2)*ec_diff(3)) - temp_diff2 = -(es(2)*es(3)*ec_diff(3)) + temp_diff4 = -(es(2)*es(3)*ec_diff(3)) es_diff(3) = es_diff(3) + es(2)*temp_diff1 - sinc*ec_msh(1)* + ec_diff(3) sinc_diff = (es(2)*ec_msh(2)+es(3)*ec_msh(3))*ec_diff(1) - + es(3)*ec_msh(1)*ec_diff(3) - es(2)*ec_diff(2) ec_msh_diff(1) = ec_msh_diff(1) + cosc*ec_diff(1) - es(3)* + sinc*ec_diff(3) - cosc_diff = (1.0-es(2)**2)*temp_diff4 - ec_msh(2)*temp_diff2 - ec_msh_diff(2) = ec_msh_diff(2) + (1-cosc)*temp_diff2 + (es( + cosc_diff = (1.0-es(2)**2)*temp_diff5 - ec_msh(2)*temp_diff4 + ec_msh_diff(2) = ec_msh_diff(2) + (1-cosc)*temp_diff4 + (es( + 3)**2*(1-cosc)+cosc)*ec_diff(2) + es(2)*sinc*ec_diff(1) es_diff(2) = es_diff(2) + es(3)*temp_diff1 CALL POPREAL8(ec(2)) temp_diff1 = -((1-cosc)*ec_msh(3)*ec_diff(2)) - es_diff(2) = es_diff(2) + 2*es(2)*(1-cosc)*temp_diff4 + es(3 + es_diff(2) = es_diff(2) + 2*es(2)*(1-cosc)*temp_diff5 + es(3 + )*temp_diff1 - sinc*ec_diff(2) + sinc*ec_msh(2)*ec_diff(1) - temp_diff4 = ec_msh(2)*ec_diff(2) - temp_diff2 = -(es(2)*es(3)*ec_diff(2)) + temp_diff5 = ec_msh(2)*ec_diff(2) + temp_diff4 = -(es(2)*es(3)*ec_diff(2)) ec_msh_diff(3) = ec_msh_diff(3) + (es(2)**2*(1-cosc)+cosc)* - + ec_diff(3) + (1-cosc)*temp_diff2 + es(3)*sinc*ec_diff(1) + + ec_diff(3) + (1-cosc)*temp_diff4 + es(3)*sinc*ec_diff(1) ec_diff(3) = 0.D0 ec_diff(2) = 0.D0 - cosc_diff = cosc_diff + (1.0-es(3)**2)*temp_diff4 - ec_msh(3 - + )*temp_diff2 + ec_msh(1)*ec_diff(1) + cosc_diff = cosc_diff + (1.0-es(3)**2)*temp_diff5 - ec_msh(3 + + )*temp_diff4 + ec_msh(1)*ec_diff(1) es_diff(3) = es_diff(3) + es(2)*temp_diff1 + 2*es(3)*(1-cosc - + )*temp_diff4 + sinc*ec_msh(3)*ec_diff(1) + + )*temp_diff5 + sinc*ec_msh(3)*ec_diff(1) CALL POPREAL8(ec(1)) ec_diff(1) = 0.D0 END IF @@ -5140,14 +5155,14 @@ SUBROUTINE ENCALC_B() END IF CALL POPREAL8(emag) IF (ecxb(1)**2 + ecxb(2)**2 + ecxb(3)**2 .EQ. 0.D0) THEN - temp_diff4 = 0.D0 + temp_diff5 = 0.D0 ELSE - temp_diff4 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + temp_diff5 = emag_diff/(2.0*SQRT(ecxb(1)**2+ecxb(2)**2+ecxb( + 3)**2)) END IF - ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff4 - ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff4 - ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff4 + ecxb_diff(1) = ecxb_diff(1) + 2*ecxb(1)*temp_diff5 + ecxb_diff(2) = ecxb_diff(2) + 2*ecxb(2)*temp_diff5 + ecxb_diff(3) = ecxb_diff(3) + 2*ecxb(3)*temp_diff5 CALL POPREAL8ARRAY(ecxb, 3) CALL CROSS_B(ec, ec_diff, eb, eb_diff, ecxb, ecxb_diff) n = 0 @@ -5164,15 +5179,15 @@ SUBROUTINE ENCALC_B() cosc_diff = ec_diff(1) ec_diff(1) = 0.D0 ELSE - temp_diff2 = -(es(2)*es(3)*ec_diff(3)) - cosc_diff = -(ec_msh(2)*temp_diff2) - ec_msh_diff(2) = ec_msh_diff(2) + (1-cosc)*temp_diff2 + (es( + temp_diff4 = -(es(2)*es(3)*ec_diff(3)) + cosc_diff = -(ec_msh(2)*temp_diff4) + ec_msh_diff(2) = ec_msh_diff(2) + (1-cosc)*temp_diff4 + (es( + 3)**2*(1-cosc)+cosc)*ec_diff(2) + es(2)*sinc*ec_diff(1) - temp_diff2 = -(es(2)*es(3)*ec_diff(2)) + temp_diff4 = -(es(2)*es(3)*ec_diff(2)) CALL POPREAL8(ec(3)) - temp_diff4 = ec_msh(3)*ec_diff(3) + temp_diff5 = ec_msh(3)*ec_diff(3) ec_msh_diff(3) = ec_msh_diff(3) + (es(2)**2*(1-cosc)+cosc)* - + ec_diff(3) + (1-cosc)*temp_diff2 + es(3)*sinc*ec_diff(1) + + ec_diff(3) + (1-cosc)*temp_diff4 + es(3)*sinc*ec_diff(1) temp_diff1 = -((1-cosc)*ec_msh(2)*ec_diff(3)) es_diff(3) = es_diff(3) + es(2)*temp_diff1 - sinc*ec_msh(1)* + ec_diff(3) @@ -5182,39 +5197,37 @@ SUBROUTINE ENCALC_B() + sinc*ec_diff(3) ec_diff(3) = 0.D0 es_diff(2) = es_diff(2) + es(3)*temp_diff1 + 2*es(2)*(1-cosc - + )*temp_diff4 + + )*temp_diff5 CALL POPREAL8(ec(2)) temp_diff1 = ec_msh(2)*ec_diff(2) - cosc_diff = cosc_diff + (1.0-es(2)**2)*temp_diff4 + (1.0-es( - + 3)**2)*temp_diff1 - ec_msh(3)*temp_diff2 + ec_msh(1)* + cosc_diff = cosc_diff + (1.0-es(2)**2)*temp_diff5 + (1.0-es( + + 3)**2)*temp_diff1 - ec_msh(3)*temp_diff4 + ec_msh(1)* + ec_diff(1) - temp_diff4 = -((1-cosc)*ec_msh(3)*ec_diff(2)) - es_diff(2) = es_diff(2) + es(3)*temp_diff4 - sinc*ec_diff(2) + temp_diff5 = -((1-cosc)*ec_msh(3)*ec_diff(2)) + es_diff(2) = es_diff(2) + es(3)*temp_diff5 - sinc*ec_diff(2) + + sinc*ec_msh(2)*ec_diff(1) ec_diff(2) = 0.D0 - es_diff(3) = es_diff(3) + es(2)*temp_diff4 + 2*es(3)*(1-cosc + es_diff(3) = es_diff(3) + es(2)*temp_diff5 + 2*es(3)*(1-cosc + )*temp_diff1 + sinc*ec_msh(3)*ec_diff(1) CALL POPREAL8(ec(1)) ec_diff(1) = 0.D0 CALL POPREAL8(ec_msh(3)) - temp_diff2 = ec_msh_diff(3)/emag + temp_diff4 = ec_msh_diff(3)/emag ec_msh_diff(3) = 0.D0 - rcmsh_diff(3, i) = rcmsh_diff(3, i) + temp_diff2 - rvmsh_diff(3, i) = rvmsh_diff(3, i) - temp_diff2 - emag_diff = -((rcmsh(3, i)-rvmsh(3, i))*temp_diff2/emag) + rcmsh_diff(3, i) = rcmsh_diff(3, i) + temp_diff4 + rvmsh_diff(3, i) = rvmsh_diff(3, i) - temp_diff4 + emag_diff = -((rcmsh(3, i)-rvmsh(3, i))*temp_diff4/emag) CALL POPREAL8(ec_msh(2)) - temp_diff2 = ec_msh_diff(2)/emag + temp_diff4 = ec_msh_diff(2)/emag ec_msh_diff(2) = 0.D0 - rcmsh_diff(2, i) = rcmsh_diff(2, i) + temp_diff2 - rvmsh_diff(2, i) = rvmsh_diff(2, i) - temp_diff2 - emag_diff = emag_diff - (rcmsh(2, i)-rvmsh(2, i))*temp_diff2 + rcmsh_diff(2, i) = rcmsh_diff(2, i) + temp_diff4 + rvmsh_diff(2, i) = rvmsh_diff(2, i) - temp_diff4 + emag_diff = emag_diff - (rcmsh(2, i)-rvmsh(2, i))*temp_diff4 + /emag CALL POPREAL8(ec_msh(1)) - temp_diff2 = ec_msh_diff(1)/emag + temp_diff4 = ec_msh_diff(1)/emag ec_msh_diff(1) = 0.D0 - rcmsh_diff(1, i) = rcmsh_diff(1, i) + temp_diff2 - rvmsh_diff(1, i) = rvmsh_diff(1, i) - temp_diff2 - emag_diff = emag_diff - (rcmsh(1, i)-rvmsh(1, i))*temp_diff2 + emag_diff = emag_diff - (rcmsh(1, i)-rvmsh(1, i))*temp_diff4 + /emag CALL POPREAL8(emag) temp0 = rcmsh(3, i) - rvmsh(3, i) @@ -5227,14 +5240,16 @@ SUBROUTINE ENCALC_B() + )) END IF temp_diff3 = 2*temp1*temp_diff2 + rcmsh_diff(1, i) = rcmsh_diff(1, i) + temp_diff4 + + + temp_diff3 + rvmsh_diff(1, i) = rvmsh_diff(1, i) - temp_diff4 - + + temp_diff3 temp_diff = 2*temp*temp_diff2 temp_diff0 = 2*temp0*temp_diff2 rcmsh_diff(3, i) = rcmsh_diff(3, i) + temp_diff0 rvmsh_diff(3, i) = rvmsh_diff(3, i) - temp_diff0 rcmsh_diff(2, i) = rcmsh_diff(2, i) + temp_diff rvmsh_diff(2, i) = rvmsh_diff(2, i) - temp_diff - rcmsh_diff(1, i) = rcmsh_diff(1, i) + temp_diff3 - rvmsh_diff(1, i) = rvmsh_diff(1, i) - temp_diff3 END IF CALL POPREAL8(cosc) ang_diff = COS(ang)*sinc_diff - SIN(ang)*cosc_diff diff --git a/src/ad_src/reverse_ad_src/amode_b.f b/src/ad_src/reverse_ad_src/amode_b.f index 48a096f..d5fbc4e 100644 --- a/src/ad_src/reverse_ad_src/amode_b.f +++ b/src/ad_src/reverse_ad_src/amode_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of set_params in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: parval mach @@ -8,6 +8,7 @@ C C SUBROUTINE SET_PARAMS_B(ir) +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER ir @@ -31,7 +32,6 @@ SUBROUTINE SET_PARAMS_B(ir) REAL rixy REAL riyz REAL rizx -C C parval_diff(ipmach, ir) = parval_diff(ipmach, ir) + mach_diff END diff --git a/src/ad_src/reverse_ad_src/aoper_b.f b/src/ad_src/reverse_ad_src/aoper_b.f index c79ab54..cc1ba71 100644 --- a/src/ad_src/reverse_ad_src/aoper_b.f +++ b/src/ad_src/reverse_ad_src/aoper_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of calc_stab_derivs in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: cftot_d cxtot_u_ba cytot_u_ba @@ -57,15 +57,16 @@ SUBROUTINE CALC_STAB_DERIVS_B() REAL(kind=avl_real) abs1 REAL(kind=avl_real) abs2 REAL(kind=avl_real) abs2_diff - REAL(kind=avl_real) temp_diff + REAL(kind=8) temp_diff INTEGER ii1 REAL(kind=avl_real) temp_diff0 + REAL(kind=avl_real) temp_diff1 INTEGER ii2 - INTEGER*4 branch + INTEGER branch C + CALL GETSA(lnasa_sa, satype, dir) C CALL VINFAB C CALL AERO - CALL GETSA(lnasa_sa, satype, dir) C C---- set freestream velocity components from alpha, beta C @@ -211,83 +212,83 @@ SUBROUTINE CALC_STAB_DERIVS_B() cmtot_u_diff(ii2, ii1) = 0.D0 ENDDO ENDDO - temp_diff0 = 2.0*cntot_u_ba_diff(6)/bref + temp_diff1 = 2.0*cntot_u_ba_diff(6)/bref cntot_u_ba_diff(6) = 0.D0 - cmtot_u_diff(3, 6) = cmtot_u_diff(3, 6) + temp_diff0 - bref_diff = -(cmtot_u(3, 6)*temp_diff0/bref) - temp_diff0 = dir*2.0*cntot_u_ba_diff(5)/cref + cmtot_u_diff(3, 6) = cmtot_u_diff(3, 6) + temp_diff1 + bref_diff = -(cmtot_u(3, 6)*temp_diff1/bref) + temp_diff1 = dir*2.0*cntot_u_ba_diff(5)/cref cntot_u_ba_diff(5) = 0.D0 - cmtot_u_diff(3, 5) = cmtot_u_diff(3, 5) + temp_diff0 - cref_diff = -(cmtot_u(3, 5)*temp_diff0/cref) - temp_diff0 = 2.0*cntot_u_ba_diff(4)/bref + cmtot_u_diff(3, 5) = cmtot_u_diff(3, 5) + temp_diff1 + cref_diff = -(cmtot_u(3, 5)*temp_diff1/cref) + temp_diff1 = 2.0*cntot_u_ba_diff(4)/bref cntot_u_ba_diff(4) = 0.D0 - cmtot_u_diff(3, 4) = cmtot_u_diff(3, 4) + temp_diff0 - bref_diff = bref_diff - cmtot_u(3, 4)*temp_diff0/bref - temp_diff0 = dir*2.0*cmtot_u_ba_diff(6)/bref + cmtot_u_diff(3, 4) = cmtot_u_diff(3, 4) + temp_diff1 + bref_diff = bref_diff - cmtot_u(3, 4)*temp_diff1/bref + temp_diff1 = dir*2.0*cmtot_u_ba_diff(6)/bref cmtot_u_ba_diff(6) = 0.D0 - cmtot_u_diff(2, 6) = cmtot_u_diff(2, 6) + temp_diff0 - bref_diff = bref_diff - cmtot_u(2, 6)*temp_diff0/bref - temp_diff0 = 2.0*cmtot_u_ba_diff(5)/cref + cmtot_u_diff(2, 6) = cmtot_u_diff(2, 6) + temp_diff1 + bref_diff = bref_diff - cmtot_u(2, 6)*temp_diff1/bref + temp_diff1 = 2.0*cmtot_u_ba_diff(5)/cref cmtot_u_ba_diff(5) = 0.D0 - cmtot_u_diff(2, 5) = cmtot_u_diff(2, 5) + temp_diff0 - cref_diff = cref_diff - cmtot_u(2, 5)*temp_diff0/cref - temp_diff0 = dir*2.0*cmtot_u_ba_diff(4)/bref + cmtot_u_diff(2, 5) = cmtot_u_diff(2, 5) + temp_diff1 + cref_diff = cref_diff - cmtot_u(2, 5)*temp_diff1/cref + temp_diff1 = dir*2.0*cmtot_u_ba_diff(4)/bref cmtot_u_ba_diff(4) = 0.D0 - cmtot_u_diff(2, 4) = cmtot_u_diff(2, 4) + temp_diff0 - bref_diff = bref_diff - cmtot_u(2, 4)*temp_diff0/bref - temp_diff0 = 2.0*crtot_u_ba_diff(6)/bref + cmtot_u_diff(2, 4) = cmtot_u_diff(2, 4) + temp_diff1 + bref_diff = bref_diff - cmtot_u(2, 4)*temp_diff1/bref + temp_diff1 = 2.0*crtot_u_ba_diff(6)/bref crtot_u_ba_diff(6) = 0.D0 - cmtot_u_diff(1, 6) = cmtot_u_diff(1, 6) + temp_diff0 - bref_diff = bref_diff - cmtot_u(1, 6)*temp_diff0/bref - temp_diff0 = dir*2.0*crtot_u_ba_diff(5)/cref + cmtot_u_diff(1, 6) = cmtot_u_diff(1, 6) + temp_diff1 + bref_diff = bref_diff - cmtot_u(1, 6)*temp_diff1/bref + temp_diff1 = dir*2.0*crtot_u_ba_diff(5)/cref crtot_u_ba_diff(5) = 0.D0 - cmtot_u_diff(1, 5) = cmtot_u_diff(1, 5) + temp_diff0 - cref_diff = cref_diff - cmtot_u(1, 5)*temp_diff0/cref - temp_diff0 = 2.0*crtot_u_ba_diff(4)/bref + cmtot_u_diff(1, 5) = cmtot_u_diff(1, 5) + temp_diff1 + cref_diff = cref_diff - cmtot_u(1, 5)*temp_diff1/cref + temp_diff1 = 2.0*crtot_u_ba_diff(4)/bref crtot_u_ba_diff(4) = 0.D0 - cmtot_u_diff(1, 4) = cmtot_u_diff(1, 4) + temp_diff0 - bref_diff = bref_diff - cmtot_u(1, 4)*temp_diff0/bref + cmtot_u_diff(1, 4) = cmtot_u_diff(1, 4) + temp_diff1 + bref_diff = bref_diff - cmtot_u(1, 4)*temp_diff1/bref DO ii1=1,numax DO ii2=1,3 cftot_u_diff(ii2, ii1) = 0.D0 ENDDO ENDDO - temp_diff0 = 2.0*cztot_u_ba_diff(6)/bref + temp_diff1 = 2.0*cztot_u_ba_diff(6)/bref cztot_u_ba_diff(6) = 0.D0 - cftot_u_diff(3, 6) = cftot_u_diff(3, 6) + temp_diff0 - bref_diff = bref_diff - cftot_u(3, 6)*temp_diff0/bref - temp_diff0 = dir*2.0*cztot_u_ba_diff(5)/cref + cftot_u_diff(3, 6) = cftot_u_diff(3, 6) + temp_diff1 + bref_diff = bref_diff - cftot_u(3, 6)*temp_diff1/bref + temp_diff1 = dir*2.0*cztot_u_ba_diff(5)/cref cztot_u_ba_diff(5) = 0.D0 - cftot_u_diff(3, 5) = cftot_u_diff(3, 5) + temp_diff0 - cref_diff = cref_diff - cftot_u(3, 5)*temp_diff0/cref - temp_diff0 = 2.0*cztot_u_ba_diff(4)/bref + cftot_u_diff(3, 5) = cftot_u_diff(3, 5) + temp_diff1 + cref_diff = cref_diff - cftot_u(3, 5)*temp_diff1/cref + temp_diff1 = 2.0*cztot_u_ba_diff(4)/bref cztot_u_ba_diff(4) = 0.D0 - cftot_u_diff(3, 4) = cftot_u_diff(3, 4) + temp_diff0 - bref_diff = bref_diff - cftot_u(3, 4)*temp_diff0/bref - temp_diff0 = dir*2.0*cytot_u_ba_diff(6)/bref + cftot_u_diff(3, 4) = cftot_u_diff(3, 4) + temp_diff1 + bref_diff = bref_diff - cftot_u(3, 4)*temp_diff1/bref + temp_diff1 = dir*2.0*cytot_u_ba_diff(6)/bref cytot_u_ba_diff(6) = 0.D0 - cftot_u_diff(2, 6) = cftot_u_diff(2, 6) + temp_diff0 - bref_diff = bref_diff - cftot_u(2, 6)*temp_diff0/bref - temp_diff0 = 2.0*cytot_u_ba_diff(5)/cref + cftot_u_diff(2, 6) = cftot_u_diff(2, 6) + temp_diff1 + bref_diff = bref_diff - cftot_u(2, 6)*temp_diff1/bref + temp_diff1 = 2.0*cytot_u_ba_diff(5)/cref cytot_u_ba_diff(5) = 0.D0 - cftot_u_diff(2, 5) = cftot_u_diff(2, 5) + temp_diff0 - cref_diff = cref_diff - cftot_u(2, 5)*temp_diff0/cref - temp_diff0 = dir*2.0*cytot_u_ba_diff(4)/bref + cftot_u_diff(2, 5) = cftot_u_diff(2, 5) + temp_diff1 + cref_diff = cref_diff - cftot_u(2, 5)*temp_diff1/cref + temp_diff1 = dir*2.0*cytot_u_ba_diff(4)/bref cytot_u_ba_diff(4) = 0.D0 - cftot_u_diff(2, 4) = cftot_u_diff(2, 4) + temp_diff0 - bref_diff = bref_diff - cftot_u(2, 4)*temp_diff0/bref - temp_diff0 = 2.0*cxtot_u_ba_diff(6)/bref + cftot_u_diff(2, 4) = cftot_u_diff(2, 4) + temp_diff1 + bref_diff = bref_diff - cftot_u(2, 4)*temp_diff1/bref + temp_diff1 = 2.0*cxtot_u_ba_diff(6)/bref cxtot_u_ba_diff(6) = 0.D0 - cftot_u_diff(1, 6) = cftot_u_diff(1, 6) + temp_diff0 - bref_diff = bref_diff - cftot_u(1, 6)*temp_diff0/bref - temp_diff0 = dir*2.0*cxtot_u_ba_diff(5)/cref + cftot_u_diff(1, 6) = cftot_u_diff(1, 6) + temp_diff1 + bref_diff = bref_diff - cftot_u(1, 6)*temp_diff1/bref + temp_diff1 = dir*2.0*cxtot_u_ba_diff(5)/cref cxtot_u_ba_diff(5) = 0.D0 - cftot_u_diff(1, 5) = cftot_u_diff(1, 5) + temp_diff0 - cref_diff = cref_diff - cftot_u(1, 5)*temp_diff0/cref - temp_diff0 = 2.0*cxtot_u_ba_diff(4)/bref + cftot_u_diff(1, 5) = cftot_u_diff(1, 5) + temp_diff1 + cref_diff = cref_diff - cftot_u(1, 5)*temp_diff1/cref + temp_diff1 = 2.0*cxtot_u_ba_diff(4)/bref cxtot_u_ba_diff(4) = 0.D0 - cftot_u_diff(1, 4) = cftot_u_diff(1, 4) + temp_diff0 - bref_diff = bref_diff - cftot_u(1, 4)*temp_diff0/bref + cftot_u_diff(1, 4) = cftot_u_diff(1, 4) + temp_diff1 + bref_diff = bref_diff - cftot_u(1, 4)*temp_diff1/bref cmtot_u_diff(3, 3) = cmtot_u_diff(3, 3) - cntot_u_ba_diff(3) cntot_u_ba_diff(3) = 0.D0 cmtot_u_diff(3, 2) = cmtot_u_diff(3, 2) - dir*cntot_u_ba_diff(2) @@ -338,12 +339,12 @@ SUBROUTINE CALC_STAB_DERIVS_B() END IF CALL POPCONTROL1B(branch) IF (branch .NE. 0) THEN - temp_diff = bb_diff/(crtot_rz*cntot_be) - crtot_be_diff = crtot_be_diff + cntot_rz*temp_diff - cntot_rz_diff = cntot_rz_diff + crtot_be*temp_diff - temp_diff0 = -(crtot_be*cntot_rz*temp_diff/(crtot_rz*cntot_be)) - crtot_rz_diff = crtot_rz_diff + cntot_be*temp_diff0 - cntot_be_diff = cntot_be_diff + crtot_rz*temp_diff0 + temp_diff0 = bb_diff/(crtot_rz*cntot_be) + crtot_be_diff = crtot_be_diff + cntot_rz*temp_diff0 + cntot_rz_diff = cntot_rz_diff + crtot_be*temp_diff0 + temp_diff1 = -(crtot_be*cntot_rz*temp_diff0/(crtot_rz*cntot_be)) + crtot_rz_diff = crtot_rz_diff + cntot_be*temp_diff1 + cntot_be_diff = cntot_be_diff + crtot_rz*temp_diff1 bb_diff = 0.D0 END IF CALL POPCONTROL1B(branch) @@ -364,61 +365,61 @@ SUBROUTINE CALC_STAB_DERIVS_B() sm_diff = 0.D0 END IF CALL POPREAL8(cntot_rz) - temp_diff = dir*2.0*cntot_rz_diff/bref - cntot_rz_diff = temp_diff - bref_diff = bref_diff - cntot_rz*temp_diff/bref - temp_diff = dir*2.0*cntot_ry_diff/cref - cntot_ry_diff = temp_diff - cref_diff = cref_diff - cntot_ry*temp_diff/cref - temp_diff = dir*2.0*cntot_rx_diff/bref - cntot_rx_diff = temp_diff - bref_diff = bref_diff - cntot_rx*temp_diff/bref - temp_diff = 2.0*cmtot_rz_diff/bref - cmtot_rz_diff = temp_diff - bref_diff = bref_diff - cmtot_rz*temp_diff/bref - temp_diff = 2.0*cmtot_ry_diff/cref - cmtot_ry_diff = temp_diff - cref_diff = cref_diff - cmtot_ry*temp_diff/cref - temp_diff = 2.0*cmtot_rx_diff/bref - cmtot_rx_diff = temp_diff - bref_diff = bref_diff - cmtot_rx*temp_diff/bref + temp_diff0 = dir*2.0*cntot_rz_diff/bref + cntot_rz_diff = temp_diff0 + bref_diff = bref_diff - cntot_rz*temp_diff0/bref + temp_diff0 = dir*2.0*cntot_ry_diff/cref + cntot_ry_diff = temp_diff0 + cref_diff = cref_diff - cntot_ry*temp_diff0/cref + temp_diff0 = dir*2.0*cntot_rx_diff/bref + cntot_rx_diff = temp_diff0 + bref_diff = bref_diff - cntot_rx*temp_diff0/bref + temp_diff0 = 2.0*cmtot_rz_diff/bref + cmtot_rz_diff = temp_diff0 + bref_diff = bref_diff - cmtot_rz*temp_diff0/bref + temp_diff0 = 2.0*cmtot_ry_diff/cref + cmtot_ry_diff = temp_diff0 + cref_diff = cref_diff - cmtot_ry*temp_diff0/cref + temp_diff0 = 2.0*cmtot_rx_diff/bref + cmtot_rx_diff = temp_diff0 + bref_diff = bref_diff - cmtot_rx*temp_diff0/bref CALL POPREAL8(crtot_rz) - temp_diff = dir*2.0*crtot_rz_diff/bref - crtot_rz_diff = temp_diff - bref_diff = bref_diff - crtot_rz*temp_diff/bref - temp_diff = dir*2.0*crtot_ry_diff/cref - crtot_ry_diff = temp_diff - cref_diff = cref_diff - crtot_ry*temp_diff/cref - temp_diff = dir*2.0*crtot_rx_diff/bref - crtot_rx_diff = temp_diff - bref_diff = bref_diff - crtot_rx*temp_diff/bref - temp_diff = 2.0*cdtot_rz_diff/bref - cdtot_rz_diff = temp_diff - bref_diff = bref_diff - cdtot_rz*temp_diff/bref - temp_diff = 2.0*cdtot_ry_diff/cref - cdtot_ry_diff = temp_diff - cref_diff = cref_diff - cdtot_ry*temp_diff/cref - temp_diff = 2.0*cdtot_rx_diff/bref - cdtot_rx_diff = temp_diff - bref_diff = bref_diff - cdtot_rx*temp_diff/bref - temp_diff = 2.0*cytot_rz_diff/bref - cytot_rz_diff = temp_diff - bref_diff = bref_diff - cytot_rz*temp_diff/bref - temp_diff = 2.0*cytot_ry_diff/cref - cytot_ry_diff = temp_diff - cref_diff = cref_diff - cytot_ry*temp_diff/cref - temp_diff = 2.0*cytot_rx_diff/bref - cytot_rx_diff = temp_diff - bref_diff = bref_diff - cytot_rx*temp_diff/bref - temp_diff = 2.0*cltot_rz_diff/bref - cltot_rz_diff = temp_diff - bref_diff = bref_diff - cltot_rz*temp_diff/bref - temp_diff = 2.0*cltot_ry_diff/cref - cltot_ry_diff = temp_diff - cref_diff = cref_diff - cltot_ry*temp_diff/cref - temp_diff = 2.0*cltot_rx_diff/bref - cltot_rx_diff = temp_diff - bref_diff = bref_diff - cltot_rx*temp_diff/bref + temp_diff0 = dir*2.0*crtot_rz_diff/bref + crtot_rz_diff = temp_diff0 + bref_diff = bref_diff - crtot_rz*temp_diff0/bref + temp_diff0 = dir*2.0*crtot_ry_diff/cref + crtot_ry_diff = temp_diff0 + cref_diff = cref_diff - crtot_ry*temp_diff0/cref + temp_diff0 = dir*2.0*crtot_rx_diff/bref + crtot_rx_diff = temp_diff0 + bref_diff = bref_diff - crtot_rx*temp_diff0/bref + temp_diff0 = 2.0*cdtot_rz_diff/bref + cdtot_rz_diff = temp_diff0 + bref_diff = bref_diff - cdtot_rz*temp_diff0/bref + temp_diff0 = 2.0*cdtot_ry_diff/cref + cdtot_ry_diff = temp_diff0 + cref_diff = cref_diff - cdtot_ry*temp_diff0/cref + temp_diff0 = 2.0*cdtot_rx_diff/bref + cdtot_rx_diff = temp_diff0 + bref_diff = bref_diff - cdtot_rx*temp_diff0/bref + temp_diff0 = 2.0*cytot_rz_diff/bref + cytot_rz_diff = temp_diff0 + bref_diff = bref_diff - cytot_rz*temp_diff0/bref + temp_diff0 = 2.0*cytot_ry_diff/cref + cytot_ry_diff = temp_diff0 + cref_diff = cref_diff - cytot_ry*temp_diff0/cref + temp_diff0 = 2.0*cytot_rx_diff/bref + cytot_rx_diff = temp_diff0 + bref_diff = bref_diff - cytot_rx*temp_diff0/bref + temp_diff0 = 2.0*cltot_rz_diff/bref + cltot_rz_diff = temp_diff0 + bref_diff = bref_diff - cltot_rz*temp_diff0/bref + temp_diff0 = 2.0*cltot_ry_diff/cref + cltot_ry_diff = temp_diff0 + cref_diff = cref_diff - cltot_ry*temp_diff0/cref + temp_diff0 = 2.0*cltot_rx_diff/bref + cltot_rx_diff = temp_diff0 + bref_diff = bref_diff - cltot_rx*temp_diff0/bref cntot_be_diff = dir*cntot_be_diff cntot_al_diff = dir*cntot_al_diff crtot_be_diff = dir*crtot_be_diff @@ -671,9 +672,9 @@ SUBROUTINE CALC_STAB_DERIVS_B() C C ======================== res and Adjoint for GAM ======== SUBROUTINE GET_RES_B() +C use avl_heap_inc use avl_heap_diff_inc -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER i, ic @@ -685,16 +686,15 @@ SUBROUTINE GET_RES_B() INTEGER l INTEGER iu INTEGER ii1 - INTEGER*4 branch INTEGER ii2 INTEGER ii3 + CALL SET_PAR_AND_CONS(nitmax, irun) C Do not use this routine in the sovler C IF(.NOT.LAIC) THEN C CALL build_AIC C end if - CALL SET_PAR_AND_CONS(nitmax, irun) C--- - CALL PUSHREAL8ARRAY(wc_gam, avl_real*3*nvmax**2/8) +c CALL PUSHREAL8ARRAY(wc_gam, 3*nvmax**2) wc_gam is unchanged c CALL BUILD_AIC() no need to build the AIC again because we assume analysis is run before amach = mach betm = SQRT(1.0 - amach**2) @@ -708,14 +708,6 @@ SUBROUTINE GET_RES_B() C C---- set VINF() vector from initial ALFA,BETA CALL VINFAB() - DO ic=1,ncontrol -C------ don't bother if this control variable is undefined - IF (lcondef(ic)) THEN - CALL PUSHCONTROL1B(1) - ELSE - CALL PUSHCONTROL1B(0) - END IF - ENDDO DO ii1=1,nvor DO ii2=1,nvor aicn_diff(ii2, ii1) = 0.D0 @@ -738,10 +730,12 @@ SUBROUTINE GET_RES_B() DO ii1=1,nvor rhs_d_diff(ii1) = 0.D0 ENDDO - DO ic=ncontrol,1,-1 - CALL POPCONTROL1B(branch) - IF (branch .NE. 0) THEN - DO i=nvor,1,-1 +C$BWD-OF II-LOOP + DO ic=1,ncontrol +C------ don't bother if this control variable is undefined + IF (lcondef(ic)) THEN +C$BWD-OF II-LOOP + DO i=1,nvor rhs_d_diff(i) = rhs_d_diff(i) - res_d_diff(i, ic) ENDDO CALL SET_GAM_D_RHS_B(ic, enc_d, enc_d_diff, rhs_d, rhs_d_diff) @@ -755,7 +749,8 @@ SUBROUTINE GET_RES_B() DO ii1=1,nvor rhs_diff(ii1) = 0.D0 ENDDO - DO i=nvor,1,-1 +C$BWD-OF II-LOOP + DO i=1,nvor rhs_diff(i) = rhs_diff(i) - res_diff(i) ENDDO CALL MAT_PROD_B(aicn, aicn_diff, gam, gam_diff, nvor, res, @@ -817,7 +812,7 @@ SUBROUTINE GET_RES_B() amach_diff = -(2*amach*betm_diff/(2.0*SQRT(1.0-amach**2))) END IF mach_diff = mach_diff + amach_diff - CALL POPREAL8ARRAY(wc_gam, avl_real*3*nvmax**2/8) +c CALL POPREAL8ARRAY(wc_gam, 3*nvmax**2) wc_gam unchaged CALL BUILD_AIC_B() CALL SET_PAR_AND_CONS_B(nitmax, irun) mach_diff = 0.D0 diff --git a/src/ad_src/reverse_ad_src/asetup_b.f b/src/ad_src/reverse_ad_src/asetup_b.f index dfd4d95..82e5956 100644 --- a/src/ad_src/reverse_ad_src/asetup_b.f +++ b/src/ad_src/reverse_ad_src/asetup_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of build_aic in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: aicn ysym zsym mach rv1 rv2 @@ -12,7 +12,6 @@ SUBROUTINE BUILD_AIC_B() use avl_heap_inc use avl_heap_diff_inc -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' REAL betm @@ -110,7 +109,6 @@ SUBROUTINE BUILD_AIC_B() SUBROUTINE VELSUM_B() use avl_heap_inc use avl_heap_diff_inc -C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' INTEGER i @@ -206,7 +204,7 @@ SUBROUTINE SET_PAR_AND_CONS_B(niter, ir) C INTEGER ii2 INTEGER ii1 - INTEGER*4 branch + INTEGER branch IF (niter .GT. 0) THEN C----- might as well directly set operating variables if they are known IF (icon(ivalfa, ir) .EQ. icalfa) THEN @@ -306,6 +304,7 @@ SUBROUTINE SET_PAR_AND_CONS_B(niter, ir) C with respect to varying inputs: vinf wrot delcon xyzref rc C enc enc_d wcsrd_u SUBROUTINE SET_VEL_RHS_B() +C INCLUDE 'AVL.INC' INCLUDE 'AVL_ad_seeds.inc' REAL rrot(3), vunit(3), vunit_w_term(3), wunit(3) @@ -316,7 +315,7 @@ SUBROUTINE SET_VEL_RHS_B() INTEGER n REAL result1 REAL result1_diff - INTEGER*4 branch + INTEGER branch enc_diff = 0.D0 vunit_diff = 0.D0 wunit_diff = 0.D0 @@ -468,7 +467,7 @@ SUBROUTINE SET_VEL_RHS_U_B(iu) INTEGER n REAL result1 REAL result1_diff - INTEGER*4 branch + INTEGER branch INTEGER iu vunit_diff = 0.D0 vunit_w_term_diff = 0.D0 @@ -566,7 +565,7 @@ SUBROUTINE SET_GAM_D_RHS_B(iq, enc_q, enc_q_diff, rhs_vec, REAL DOT REAL result1 REAL result1_diff - INTEGER*4 branch + INTEGER branch INTEGER ii1 INTEGER iq DO ii1=1,3 diff --git a/src/ad_src/reverse_ad_src/atpforc_b.f b/src/ad_src/reverse_ad_src/atpforc_b.f index 4083632..ca46786 100644 --- a/src/ad_src/reverse_ad_src/atpforc_b.f +++ b/src/ad_src/reverse_ad_src/atpforc_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of tpforc in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: bref clff cyff cdff spanef @@ -94,12 +94,12 @@ SUBROUTINE TPFORC_B() REAL temp_diff REAL temp_diff0 REAL temp_diff1 - REAL(kind=avl_real) temp2 - REAL(kind=avl_real) temp_diff2 - REAL(kind=avl_real) temp_diff3 + REAL(kind=8) temp2 + REAL(kind=8) temp_diff2 + REAL(kind=8) temp_diff3 INTEGER ad_from INTEGER ad_to - INTEGER*4 branch + INTEGER branch INTEGER ii1 INTEGER ii2 C @@ -131,6 +131,7 @@ SUBROUTINE TPFORC_B() CALL PUSHINTEGER4(i - 1) CALL PUSHINTEGER4(ad_from) ENDDO +Ccc ENDIF C C---- set x,y,z in wind axes (Y,Z are then in Trefftz plane) DO jc=1,nstrip diff --git a/src/ad_src/reverse_ad_src/cdcl_b.f b/src/ad_src/reverse_ad_src/cdcl_b.f index 9168d5d..453e6da 100644 --- a/src/ad_src/reverse_ad_src/cdcl_b.f +++ b/src/ad_src/reverse_ad_src/cdcl_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of cdcl in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: cd_cl cd diff --git a/src/ad_src/reverse_ad_src/sgutil_b.f b/src/ad_src/reverse_ad_src/sgutil_b.f index 25abf5c..85c990a 100644 --- a/src/ad_src/reverse_ad_src/sgutil_b.f +++ b/src/ad_src/reverse_ad_src/sgutil_b.f @@ -1,5 +1,5 @@ C Generated by TAPENADE (INRIA, Ecuador team) -C Tapenade 3.16 (develop) - 22 Aug 2023 15:51 +C Tapenade 3.16 (develop) - 15 Jan 2021 14:26 C C Differentiation of akima in reverse (adjoint) mode (with options i4 dr8 r8): C gradient of useful results: x y xx yy @@ -123,7 +123,7 @@ SUBROUTINE AKIMA_B(x, x_diff, y, y_diff, n, xx, xx_diff, yy, INTEGER ii1 INTEGER ad_count INTEGER i0 - INTEGER*4 branch + INTEGER branch REAL xx REAL xx_diff REAL yy @@ -447,7 +447,7 @@ SUBROUTINE CSPACER_B(nvc, cspace, claf, claf_diff, xpt, xvr, xsr, REAL xcp2 REAL xcp2_diff INTRINSIC SIN - INTEGER*4 branch + INTEGER branch REAL claf REAL claf_diff REAL cspace diff --git a/tests/test_partial_derivs.py b/tests/test_partial_derivs.py index ba2b94e..d1527ca 100644 --- a/tests/test_partial_derivs.py +++ b/tests/test_partial_derivs.py @@ -215,7 +215,7 @@ def test_rev_gamma(self): self.ovl_solver.clear_ad_seeds_fast() for func_key in self.ovl_solver.case_var_to_fort_var: - gamma_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[2] + gamma_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[3] rev_sum = np.sum(gamma_seeds_rev * gamma_seeds_fwd) fwd_sum = np.sum(func_seeds_fwd[func_key]) @@ -262,7 +262,7 @@ def test_rev_param(self): self.ovl_solver.clear_ad_seeds_fast() for func_key in self.ovl_solver.case_var_to_fort_var: - param_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[5] + param_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[6] # print(f"{func_key} wrt {param_key}", "fwd ", func_seeds_fwd[func_key], "rev", param_seeds_rev[param_key]) tol = 1e-14 @@ -316,7 +316,7 @@ def test_rev_ref(self): self.ovl_solver.clear_ad_seeds_fast() for func_key in self.ovl_solver.case_var_to_fort_var: - ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[6] + ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[7] # print(f"{func_key} wrt {ref_key}", "fwd ", func_seeds_fwd[func_key], "rev", ref_seeds_rev[ref_key]) tol = 1e-14 @@ -465,7 +465,7 @@ def test_fwd_param(self): def test_rev_param(self): num_res = self.ovl_solver.get_mesh_size() res_seeds_rev = np.random.rand(num_res) - param_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_seeds=res_seeds_rev)[5] + param_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_seeds=res_seeds_rev)[6] self.ovl_solver.clear_ad_seeds_fast() @@ -498,7 +498,7 @@ def test_fwd_ref(self): def test_rev_ref(self): num_res = self.ovl_solver.get_mesh_size() res_seeds_rev = np.random.rand(num_res) - ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_seeds=res_seeds_rev)[6] + ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_seeds=res_seeds_rev)[7] self.ovl_solver.clear_ad_seeds_fast() diff --git a/tests/test_stab_derivs_partial_derivs.py b/tests/test_stab_derivs_partial_derivs.py index d549cc2..e404a84 100644 --- a/tests/test_stab_derivs_partial_derivs.py +++ b/tests/test_stab_derivs_partial_derivs.py @@ -165,7 +165,7 @@ def test_rev_gamma_u(self): res_u_seeds_fwd = self.ovl_solver._execute_jac_vec_prod_fwd(gamma_u_seeds=gamma_u_seeds_fwd)[6] self.ovl_solver.clear_ad_seeds_fast() - gamma_u_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_u_seeds=res_u_seeds_rev)[4] + gamma_u_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_u_seeds=res_u_seeds_rev)[5] gamma_sum = np.sum(gamma_u_seeds_rev * gamma_u_seeds_fwd) res_sum = np.sum(res_u_seeds_rev * res_u_seeds_fwd) @@ -378,7 +378,7 @@ def test_rev_gamma_u(self): # for var_key in sd_d_fwd[deriv_func]: sd_d_rev = {deriv_func: 1.0} - gamma_u_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(stab_derivs_seeds=sd_d_rev)[4] + gamma_u_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(stab_derivs_seeds=sd_d_rev)[5] rev_sum = np.sum(gamma_u_seeds_rev * gamma_u_seeds_fwd) @@ -425,7 +425,7 @@ def test_rev_ref(self): for deriv_func, var_dict in self.ovl_solver.case_stab_derivs_to_fort_var.items(): stab_deriv_seeds_rev[deriv_func] = np.random.rand(1)[0] - ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(stab_derivs_seeds=stab_deriv_seeds_rev)[6] + ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(stab_derivs_seeds=stab_deriv_seeds_rev)[7] self.ovl_solver.clear_ad_seeds_fast() diff --git a/tests/test_total_derivs.py b/tests/test_total_derivs.py index 5d562ad..f019ed7 100644 --- a/tests/test_total_derivs.py +++ b/tests/test_total_derivs.py @@ -244,6 +244,7 @@ def test_geom(self): ) for func_key in func_vars: + print(sens[func_key][surf_key]) geom_dot = np.sum(sens[func_key][surf_key][geom_key] * rand_arr) func_dot = func_seeds[func_key] From c0f7b4962b8a703e912d31bec0b698040a37ac9b Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 23 Feb 2026 14:51:14 -0500 Subject: [PATCH 45/49] wip --- tests/test_total_derivs.py | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/test_total_derivs.py b/tests/test_total_derivs.py index f019ed7..5d562ad 100644 --- a/tests/test_total_derivs.py +++ b/tests/test_total_derivs.py @@ -244,7 +244,6 @@ def test_geom(self): ) for func_key in func_vars: - print(sens[func_key][surf_key]) geom_dot = np.sum(sens[func_key][surf_key][geom_key] * rand_arr) func_dot = func_seeds[func_key] From c2d82d80e6813a6392c90e382ec8ed8d3f3e88f9 Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Mon, 23 Feb 2026 17:40:42 -0500 Subject: [PATCH 46/49] wip stuff --- optvl/optvl_class.py | 22 ++++++++++++++++------ tests/test_total_derivs.py | 1 + 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/optvl/optvl_class.py b/optvl/optvl_class.py index 6faf645..b57dbb0 100644 --- a/optvl/optvl_class.py +++ b/optvl/optvl_class.py @@ -4207,7 +4207,11 @@ def execute_run_sensitivities( sens[func].update(con_seeds) # I don't know if it's worth combining geom_seeds and mesh_seeds into one just to make this one part less nasty for key in geom_seeds: + # if func == 'e': + # import pdb + # pdb.set_trace() sens[func][key] = geom_seeds[key] | mesh_seeds[key] + # sens[func].update(geom_seeds) # sens[func].update(mesh_seeds) sens[func].update(param_seeds) sens[func].update(ref_seeds) @@ -4251,8 +4255,10 @@ def execute_run_sensitivities( time_last = time.time() sens[func_key].update(con_seeds) - sens[func_key].update(geom_seeds) - sens[func_key].update(mesh_seeds) + for key in geom_seeds: + sens[func_key][key] = geom_seeds[key] | mesh_seeds[key] + # sens[func_key].update(geom_seeds) + # sens[func_key].update(mesh_seeds) sens[func_key].update(param_seeds) sens[func_key].update(ref_seeds) @@ -4296,8 +4302,10 @@ def execute_run_sensitivities( time_last = time.time() sens[func_key].update(con_seeds) - sens[func_key].update(geom_seeds) - sens[func_key].update(mesh_seeds) + for key in geom_seeds: + sens[func_key][key] = geom_seeds[key] | mesh_seeds[key] + # sens[func_key].update(geom_seeds) + # sens[func_key].update(mesh_seeds) sens[func_key].update(param_seeds) sens[func_key].update(ref_seeds) # sd_deriv_seeds[func_key] = 0.0 @@ -4342,8 +4350,10 @@ def execute_run_sensitivities( time_last = time.time() sens[func_key].update(con_seeds) - sens[func_key].update(geom_seeds) - sens[func_key].update(mesh_seeds) + for key in geom_seeds: + sens[func_key][key] = geom_seeds[key] | mesh_seeds[key] + # sens[func_key].update(geom_seeds) + # sens[func_key].update(mesh_seeds) sens[func_key].update(param_seeds) sens[func_key].update(ref_seeds) diff --git a/tests/test_total_derivs.py b/tests/test_total_derivs.py index 5d562ad..e7b87c3 100644 --- a/tests/test_total_derivs.py +++ b/tests/test_total_derivs.py @@ -211,6 +211,7 @@ def test_geom(self): surf_key = list(self.ovl_solver.surf_geom_to_fort_var.keys())[0] geom_vars = self.ovl_solver.surf_geom_to_fort_var[surf_key] + # geom_vars += self.ovl_solver.surf_mesh_to_fort_var[surf_key] cs_names = self.ovl_solver.get_control_names() consurf_vars = [] From 6304e73d40ac25cd2ee9e762bc832fdd939e2c6a Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 23 Feb 2026 17:57:03 -0500 Subject: [PATCH 47/49] fixed borken tests --- optvl/om_wrapper.py | 4 ++-- tests/test_body_axis_derivs_partial_derivs.py | 4 ++-- tests/test_consurf_partial_derivs.py | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/optvl/om_wrapper.py b/optvl/om_wrapper.py index f47baa9..9a43395 100644 --- a/optvl/om_wrapper.py +++ b/optvl/om_wrapper.py @@ -340,7 +340,7 @@ def apply_linear(self, inputs, outputs, d_inputs, d_outputs, d_residuals, mode): res_d_seeds = d_residuals["gamma_d"] res_u_seeds = d_residuals["gamma_u"] - con_seeds, geom_seeds, gamma_seeds, gamma_d_seeds, gamma_u_seeds, param_seeds, ref_seeds = ( + con_seeds, geom_seeds, mesh_seeds, gamma_seeds, gamma_d_seeds, gamma_u_seeds, param_seeds, ref_seeds = ( self.ovl._execute_jac_vec_prod_rev( res_seeds=res_seeds, res_d_seeds=res_d_seeds, res_u_seeds=res_u_seeds ) @@ -610,7 +610,7 @@ def compute_jacvec_product(self, inputs, d_inputs, d_outputs, mode): # print(var_name, body_axis_seeds[func_key]) print(f" running rev mode derivs for {func_key}") - con_seeds, geom_seeds, gamma_seeds, gamma_d_seeds, gamma_u_seeds, param_seeds, ref_seeds = ( + con_seeds, geom_seeds, mesh_seeds, gamma_seeds, gamma_d_seeds, gamma_u_seeds, param_seeds, ref_seeds = ( self.ovl._execute_jac_vec_prod_rev( func_seeds=func_seeds, consurf_derivs_seeds=csd_seeds, diff --git a/tests/test_body_axis_derivs_partial_derivs.py b/tests/test_body_axis_derivs_partial_derivs.py index b26fccc..7359402 100644 --- a/tests/test_body_axis_derivs_partial_derivs.py +++ b/tests/test_body_axis_derivs_partial_derivs.py @@ -196,7 +196,7 @@ def test_rev_gamma_u(self): # for var_key in bd_d_fwd[deriv_func]: bd_d_rev = {deriv_func: 1.0} - gamma_u_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(body_axis_derivs_seeds=bd_d_rev)[4] + gamma_u_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(body_axis_derivs_seeds=bd_d_rev)[5] rev_sum = np.sum(gamma_u_seeds_rev * gamma_u_seeds_fwd) @@ -247,7 +247,7 @@ def test_rev_ref(self): for deriv_func, var_dict in self.ovl_solver.case_body_derivs_to_fort_var.items(): body_axis_deriv_seeds_rev[deriv_func] = np.random.rand(1)[0] - ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(body_axis_derivs_seeds=body_axis_deriv_seeds_rev)[6] + ref_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(body_axis_derivs_seeds=body_axis_deriv_seeds_rev)[7] self.ovl_solver.clear_ad_seeds_fast() diff --git a/tests/test_consurf_partial_derivs.py b/tests/test_consurf_partial_derivs.py index 8abb73b..f1a0939 100644 --- a/tests/test_consurf_partial_derivs.py +++ b/tests/test_consurf_partial_derivs.py @@ -168,7 +168,7 @@ def test_rev_gamma_d(self): res_d_seeds_fwd = self.ovl_solver._execute_jac_vec_prod_fwd(gamma_d_seeds=gamma_d_seeds_fwd)[5] self.ovl_solver.clear_ad_seeds_fast() - gamma_d_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_d_seeds=res_d_seeds_rev)[3] + gamma_d_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_d_seeds=res_d_seeds_rev)[4] gamma_sum = np.sum(gamma_d_seeds_rev * gamma_d_seeds_fwd) res_sum = np.sum(res_d_seeds_rev * res_d_seeds_fwd) @@ -359,7 +359,7 @@ def test_rev_gamma_d(self): for deriv_func in cs_d_fwd: cs_d_rev = {deriv_func: 1.0} - gamma_d_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(consurf_derivs_seeds=cs_d_rev)[3] + gamma_d_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(consurf_derivs_seeds=cs_d_rev)[4] rev_sum = np.sum(gamma_d_seeds_rev * gamma_d_seeds_fwd) From ad64e43753bdfa651a127c10deb5ad4a428a7bb6 Mon Sep 17 00:00:00 2001 From: Safa Bakhshi Date: Mon, 23 Feb 2026 19:09:57 -0500 Subject: [PATCH 48/49] Working on test for mesh derivatives --- _temp/scratch.py | 102 ++++++++++++++++++++++++++++++++++ geom_files/rect_out.avl | 41 ++++++++++++++ geom_files/rect_with_body.pkl | Bin 0 -> 1533 bytes geom_files/wing_mesh.pkl | Bin 0 -> 2003 bytes tests/test_mesh_input.py | 14 ++++- tests/test_partial_derivs.py | 9 ++- 6 files changed, 163 insertions(+), 3 deletions(-) create mode 100644 _temp/scratch.py create mode 100644 geom_files/rect_out.avl create mode 100644 geom_files/rect_with_body.pkl create mode 100644 geom_files/wing_mesh.pkl diff --git a/_temp/scratch.py b/_temp/scratch.py new file mode 100644 index 0000000..93047de --- /dev/null +++ b/_temp/scratch.py @@ -0,0 +1,102 @@ +import numpy as np + +from optvl import OVLSolver +import pickle +import os + + + +mesh = np.load("wing_mesh.npy") + + +with open("wing_mesh.pkl", 'wb') as f: + pickle.dump(mesh, f) + + + +test_mesh = np.zeros((2,2,3)) +test_mesh[1,:,0] = 1.0 +test_mesh[:,1,1] = 1.0 +test_mesh[:,:,2] = 1.0 + + +base_dir = os.path.dirname(os.path.abspath(__file__)) # Path to current folder +geom_dir = os.path.join(base_dir, '..', 'geom_files') + +rect_file = os.path.join(geom_dir, 'rect_with_body.avl') + + +surf = { + "Wing": { + # General + "component": np.int32(1), # logical surface component index (for grouping interacting surfaces, see AVL manual) + # "yduplicate": np.float64(0.0), # surface is duplicated over the ysymm plane + # Geometry + "scale": np.array( + [1.0, 1.0, 1.0], dtype=np.float64 + ), # scaling factors applied to all x,y,z coordinates (chords arealso scaled by Xscale) + "translate": np.array( + [0.0, 0.0, 0.0], dtype=np.float64 + ), # offset added on to all X,Y,Z values in this surface + # Geometry: Mesh + "mesh": np.float64(test_mesh), # (nx,ny,3) numpy array containing mesh coordinates + # Control Surface Specification + "control_assignments": { + "Elevator" : {"assignment":np.arange(0,test_mesh.shape[1]), + "xhinged": 0.5, # x/c location of hinge + "vhinged": np.array([0,1,0]), # vector giving hinge axis about which surface rotates + "gaind": -1.0, # control surface gain + "refld": 1.0 # control surface reflection, sign of deflection for duplicated surface + } + }, + + } +} + +fuselage = {"Fuse pod": { + # General + # 'yduplicate': np.float64(0), # body is duplicated over the ysymm plane + # Geometry + "scale": np.array( + [1.0, 1.0, 1.0] + ), # scaling factors applied to all x,y,z coordinates (chords areal so scaled by Xscale) + "translate": np.array([0.0, 0.0, 0.0]), # offset added on to all X,Y,Z values in this surface + # Discretization + "nvb": np.int32(4), # number of source-line nodes + "bspace": np.float64(2.0), # lengthwise node spacing parameter + "bfile": "../geom_files/fuseSimple.dat", # body oml file name +} +} + +input_dict = { + "title": "MACH MDAO AVL", + "mach": np.float64(0.0), + "iysym": np.int32(0), + "izsym": np.int32(0), + "zsym": np.float64(0.0), + "Sref": np.float64(1.123), + "Cref": np.float64(0.25), + "Bref": np.float64(6.01), + "XYZref": np.array([0.0, 0, 0],dtype=np.float64), + "CDp": np.float64(0.0), + "surfaces": surf, + "bodies": fuselage, + # Global Control and DV info + "dname": ["Elevator"], # Name of control input for each corresonding index +} + + +solver = OVLSolver(input_dict=input_dict,debug=True) +# solver = OVLSolver(geo_file=rect_file,debug=True) + +solver.set_variable("alpha", 25.0) +solver.set_variable("beta", 5.0) +solver.execute_run() + +# solver.plot_geom() +with open("rect_with_body.pkl", 'wb') as f: + pickle.dump(input_dict, f) + + + + diff --git a/geom_files/rect_out.avl b/geom_files/rect_out.avl new file mode 100644 index 0000000..1cbd4d4 --- /dev/null +++ b/geom_files/rect_out.avl @@ -0,0 +1,41 @@ +# generated using OptVL v1.4.2.dev0 +#=============================================================================== +#------------------------------------ Header ----------------------------------- +#=============================================================================== +MACH MDAO AVL +#Mach +0.12341234 +#IYsym IZsym Zsym +0 0 0.0 +#Sref Cref Bref +1.0 2.0 3.0 +#Xref Yref Zref +4.0 5.0 6.0 +#CD0 +0.0 +#=============================================================================== +#------------------------------------- Wing ------------------------------------ +#=============================================================================== +SURFACE +Wing +#Nchordwise Cspace [Nspanwise Sspace] +1 1.0 1 -2.0 +SCALE +1.0 1.0 1.0 +TRANSLATE +0.0 0.0 0.0 +ANGLE +0.0 +#--------------------------------------- +SECTION +#Xle Yle Zle | Chord Ainc Nspan Sspace + 0.000000 0.000000 0.000000 1.000000 0.000000 + CONTROL +#surface gain xhinge hvec SgnDup + Elevator -1.0 0.5 0.000000 1.000000 0.000000 1.0 +SECTION +#Xle Yle Zle | Chord Ainc Nspan Sspace + 0.000000 1.000000 0.000000 1.000000 0.000000 + CONTROL +#surface gain xhinge hvec SgnDup + Elevator -1.0 0.5 0.000000 1.000000 0.000000 1.0 diff --git a/geom_files/rect_with_body.pkl b/geom_files/rect_with_body.pkl new file mode 100644 index 0000000000000000000000000000000000000000..c4bca9ed2982bdc26b12c31036d1b54c04ac06d3 GIT binary patch literal 1533 zcmah}OK;Oa5YEF+(kc~5s8tUfa*TwOBGdy1P$(`1VOk_A@sg^rvDaCHU-GUaf>eo1 zX(R2e%P-)E@DC6-#EqX2xNwBowOyx?p?lcJ%+AcW-^}cL?c*=KqQ;@<9*V`O;JUg4tIZ}6 zmXextQ%p~e#S_sr>%4kP?CtG6`~yQxW`&8N(MmB?D&hm&iQ!voI$s zCB~XG&JEvXhO5S$Sj(mD#YozIj2#&WG}n&TzJK}sv!A-sj6##5`vvL{#`701l}_XBL5!_1pe#--1~iZ+Zw7YC*QqcoN5ZHMMaoLmtRD%|o*L^p4U4M) zl6c+NjxwmZJ`LNVN$emCQ*j8ndgcZr*mU`l75Y&a;DAXhAfyUr8Ba1{Sdi=FhJ->k z%Yn@LX`o_NK$cjH0_q`lv4vXQn%j$G$T+TtsM985aG~W`) z7`Daz{tqRs@a8xZl_$uVtCZYTYMHszN5~Dp;pbWAP=~7YWQ0tRP~L_{9Z+mB7phd4 zHQsO~7q&PM-2*64q$W&WtMeH)5Epw)-Y6{zKnxQmae6xsEN`FfF`=2S42ANQ?{SJK z%Ln}j&#P0TC7-NHSvJKb`3xJ&cM!Jb*%iuvae-GBWUsS{hxh1`p|LZw|%wO k+Zf@{AIKx!aNrU9t{-{0XCo%yiMkyiA47)80ZMv*0ku!m7XSbN literal 0 HcmV?d00001 diff --git a/geom_files/wing_mesh.pkl b/geom_files/wing_mesh.pkl new file mode 100644 index 0000000000000000000000000000000000000000..12c54646d04a44bde045f21f0632c1b8ce936598 GIT binary patch literal 2003 zcmZ|QKTASU7{_rZwRORvHz5A4ApdZ?4sI=B!reR#^%8mqO*JOe z)YKLPLDA6MQeK~a{CJ+DXE^uVugAm3tKeDo@*$s^jd-KeZ}$d;O1&F43+?_%bX*O? z>cGXTm9Sawc21+PUyt0_#ktu|7w0<-*)n!P>fG(6Yi{Tc+-8stR)Tzx8M>oPoNGjb zUNd>yQmg1j7qTN0r*~YrT;Bhkj@cBXB3B#j7XLYdO6K)@u4Q#I8*2;tve)HZS+C1E zKX>vvXX&3_=MGt2UnS$VBzJV8Tc_@HqRTmSqFbl#bfV99P8K*PrTI>D>%=+MiT!+@ z;z74goI~yQRx+MFC%Sd&PA9s3p6K>@>P{y*g|d>*_2N0vty6b8(XA8RI(4TL-8$v| z)pMd-r|xv3%az|dx^?PKC%RlY%X5D7oaol6JDuoqGM(twsXLwM6w2zbm5g`KiEf>` z(}`}K=+>z_o#@snzlRUciEf>`(}`}K=+>z_o#@v2^q7n<&xvlGy3>hno#@u7JDup( gDfi!=6Wuy>rxRVS{C%QZr|xv3%aya6{(~0&05Vc3@Bjb+ literal 0 HcmV?d00001 diff --git a/tests/test_mesh_input.py b/tests/test_mesh_input.py index 8dd506b..2554e85 100644 --- a/tests/test_mesh_input.py +++ b/tests/test_mesh_input.py @@ -1,3 +1,8 @@ +# ============================================================================= +# Standard modules +# ============================================================================= +import os + # ============================================================================= # Extension modules # ============================================================================= @@ -8,10 +13,17 @@ # ============================================================================= import unittest import numpy as np +import pickle + + +base_dir = os.path.dirname(os.path.abspath(__file__)) # Path to current folder +geom_dir = os.path.join(base_dir, '..', 'geom_files') +mesh_file = os.path.join(geom_dir, "wing_mesh.pkl") -mesh = np.load("wing_mesh.npy") +with open(mesh_file, 'rb') as f: + mesh = pickle.load(f) surf = { "Wing": { diff --git a/tests/test_partial_derivs.py b/tests/test_partial_derivs.py index d1527ca..c1c02d6 100644 --- a/tests/test_partial_derivs.py +++ b/tests/test_partial_derivs.py @@ -14,6 +14,7 @@ # ============================================================================= import unittest import numpy as np +import pickle base_dir = os.path.dirname(os.path.abspath(__file__)) # Path to current folder @@ -22,11 +23,15 @@ geom_file = os.path.join(geom_dir, "aircraft_L1_with_body.avl") # mass_file = os.path.join(geom_dir, "aircraft.mass") # rect_file = os.path.join(geom_dir, 'rect.avl') -rect_file = os.path.join(geom_dir, 'rect_with_body.avl') +# rect_file = os.path.join(geom_dir, 'rect_with_body.avl') +rect_file = os.path.join(geom_dir, 'rect_with_body.pkl') +with open(rect_file, 'rb') as f: + input_dict = pickle.load(f) class TestFunctionPartials(unittest.TestCase): def setUp(self): - self.ovl_solver = OVLSolver(geo_file=rect_file) + # self.ovl_solver = OVLSolver(geo_file=rect_file) + self.ovl_solver = OVLSolver(input_dict=input_dict) self.ovl_solver.set_variable("alpha", 25.0) self.ovl_solver.set_variable("beta", 5.0) self.ovl_solver.execute_run() From ad2310c361cac46efe5c2d0585949e49694fdd8a Mon Sep 17 00:00:00 2001 From: sabakhshi Date: Tue, 24 Feb 2026 01:28:05 -0500 Subject: [PATCH 49/49] Implemented most of the mesh derivative tests --- tests/test_mesh_partials.py | 375 +++++++++++++++++++++++++++ tests/test_mesh_totals.py | 485 +++++++++++++++++++++++++++++++++++ tests/test_partial_derivs.py | 10 +- tests/wing_mesh.npy | Bin 1976 -> 0 bytes 4 files changed, 863 insertions(+), 7 deletions(-) create mode 100644 tests/test_mesh_partials.py create mode 100644 tests/test_mesh_totals.py delete mode 100644 tests/wing_mesh.npy diff --git a/tests/test_mesh_partials.py b/tests/test_mesh_partials.py new file mode 100644 index 0000000..8cf1940 --- /dev/null +++ b/tests/test_mesh_partials.py @@ -0,0 +1,375 @@ +# ============================================================================= +# Extension modules +# ============================================================================= +from optvl import OVLSolver + +# ============================================================================= +# Standard Python Modules +# ============================================================================= +import os +import psutil + +# ============================================================================= +# External Python modules +# ============================================================================= +import unittest +import numpy as np +import pickle + + +base_dir = os.path.dirname(os.path.abspath(__file__)) # Path to current folder +geom_dir = os.path.join(base_dir, '..', 'geom_files') +rect_file = os.path.join(geom_dir, 'rect_with_body.pkl') +with open(rect_file, 'rb') as f: + input_dict = pickle.load(f) + + +class TestFunctionPartials(unittest.TestCase): + def setUp(self): + # self.ovl_solver = OVLSolver(geo_file=rect_file) + self.ovl_solver = OVLSolver(input_dict=input_dict) + self.ovl_solver.set_variable("alpha", 25.0) + self.ovl_solver.set_variable("beta", 5.0) + self.ovl_solver.execute_run() + + def tearDown(self): + # Get the memory usage of the current process using psutil + process = psutil.Process() + mb_memory = process.memory_info().rss / (1024 * 1024) # Convert bytes to MB + print(f"{self.id():80} Memory usage: {mb_memory:.2f} MB") + + def test_fwd_mesh(self): + np.random.seed(111) + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + func_seeds = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}} + )[0] + + func_seeds_FD = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}}, mode="FD", step=1e-7 + )[0] + + for func_key in func_seeds: + rel_error = np.linalg.norm(func_seeds[func_key] - func_seeds_FD[func_key]) / np.linalg.norm( + func_seeds_FD[func_key] + 1e-15 + ) + + # print( + # f"{func_key:10} wrt {surf_key}:{geom_key} AD:{func_seeds[func_key]: .5e} FD:{func_seeds_FD[func_key]: .5e} rel_error:{rel_error: .3e}" + # ) + + tol = 1e-13 + if np.abs(func_seeds[func_key]) < tol or np.abs(func_seeds_FD[func_key]) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + func_seeds[func_key], + func_seeds_FD[func_key], + atol=1e-6, + err_msg=f"func_key {func_key} w.r.t. {mesh_key}", + ) + else: + np.testing.assert_allclose( + func_seeds[func_key], + func_seeds_FD[func_key], + rtol=5e-4, + err_msg=f"func_key {func_key} w.r.t. {mesh_key}", + ) + + def test_rev_mesh(self): + np.random.seed(111) + + sens_dict_rev = {} + for func_key in self.ovl_solver.case_var_to_fort_var: + sens_dict_rev[func_key] = self.ovl_solver._execute_jac_vec_prod_rev(func_seeds={func_key: 1.0})[2] + self.ovl_solver.clear_ad_seeds_fast() + + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + func_seeds_fwd = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}} + )[0] + + for func_key in func_seeds_fwd: + # use dot product test as design variables maybe arrays + rev_sum = np.sum(sens_dict_rev[func_key][surf_key][mesh_key] * mesh_seeds) + fwd_sum = np.sum(func_seeds_fwd[func_key]) + + # # print(mesh_seeds_rev) + tol = 1e-13 + # print(f"{func_key} wrt {surf_key}:{mesh_key}", "fwd", fwd_sum, "rev", rev_sum) + if np.abs(fwd_sum) < tol or np.abs(rev_sum) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + fwd_sum, + rev_sum, + atol=1e-14, + err_msg=f"func_key {func_key} w.r.t. {surf_key}:{mesh_key}", + ) + else: + np.testing.assert_allclose( + fwd_sum, + rev_sum, + rtol=1e-12, + err_msg=f"func_key {func_key} w.r.t. {surf_key}:{mesh_key}", + ) + +class TestResidualPartials(unittest.TestCase): + def setUp(self): + # self.ovl_solver = OVLSolver(geo_file=geom_file) + self.ovl_solver = OVLSolver(input_dict=input_dict) + self.ovl_solver.set_variable("alpha", 25.0) + self.ovl_solver.set_variable("beta", 5.0) + self.ovl_solver.execute_run() + + def tearDown(self): + # Get the memory usage of the current process using psutil + process = psutil.Process() + mb_memory = process.memory_info().rss / (1024 * 1024) # Convert bytes to MB + print(f"{self.id():80} Memory usage: {mb_memory:.2f} MB") + + def test_fwd_mesh(self): + np.random.seed(111) + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + res_seeds = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}} + )[1] + + res_seeds_FD = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}}, mode="FD", step=1e-8 + )[1] + + abs_error = np.abs(res_seeds - res_seeds_FD) + rel_error = (res_seeds - res_seeds_FD) / (res_seeds + 1e-15) + idx_max_rel_error = np.argmax(np.abs(rel_error)) + idx_max_abs_error = np.argmax(np.abs(abs_error)) + + # print( + # f"{surf_key:10} {mesh_key:10} AD:{np.linalg.norm(res_seeds): .5e} FD:{np.linalg.norm(res_seeds_FD): .5e} max rel err:{(rel_error[idx_max_rel_error]): .3e} max abs err:{(np.max(abs_error)): .3e}" + # ) + np.testing.assert_allclose( + res_seeds, + res_seeds_FD, + atol=3e-5, + err_msg=f"func_key res w.r.t. {surf_key}:{mesh_key}", + ) + + def test_rev_mesh(self): + num_res = self.ovl_solver.get_mesh_size() + res_seeds_rev = np.random.seed(111) + res_seeds_rev = np.random.rand(num_res) + mesh_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_seeds=res_seeds_rev)[2] + + self.ovl_solver.clear_ad_seeds_fast() + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + res_seeds = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}} + )[1] + + # do dot product + res_sum = np.sum(res_seeds_rev * res_seeds) + geom_sum = np.sum(mesh_seeds_rev[surf_key][mesh_key] * mesh_seeds) + + # print(f"res wrt {surf_key}:{mesh_key}", "rev", geom_sum, "fwd", res_sum) + + np.testing.assert_allclose( + res_sum, + geom_sum, + atol=1e-14, + err_msg=f"func_key res w.r.t. {surf_key}:{mesh_key}", + ) + +class TestResidualUPartials(unittest.TestCase): + def setUp(self): + # self.ovl_solver = OVLSolver(geo_file=geom_file) + self.ovl_solver = OVLSolver(input_dict=input_dict) + self.ovl_solver.set_variable("alpha", 25.0) + self.ovl_solver.set_variable("beta", 5.0) + self.ovl_solver.execute_run() + + def tearDown(self): + # Get the memory usage of the current process using psutil + process = psutil.Process() + mb_memory = process.memory_info().rss / (1024 * 1024) # Convert bytes to MB + print(f"{self.id()} Memory usage: {mb_memory:.2f} MB") + + def test_fwd_mesh(self): + np.random.seed(111) + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + res_u_seeds = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}} + )[6] + + res_u_seeds_FD = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}}, mode="FD", step=1e-8 + )[6] + + abs_error = np.abs(res_u_seeds.flatten() - res_u_seeds_FD.flatten()) + rel_error = np.abs((res_u_seeds.flatten() - res_u_seeds_FD.flatten()) / (res_u_seeds.flatten() + 1e-15)) + + idx_max_rel_error = np.argmax(rel_error) + idx_max_abs_error = np.argmax(abs_error) + # print( + # f"{surf_key:10} {mesh_key:10} AD:{np.linalg.norm(res_u_seeds): .5e} FD:{np.linalg.norm(res_u_seeds_FD): .5e} max rel err:{(rel_error[idx_max_rel_error]): .3e} max abs err:{(np.max(abs_error)): .3e}" + # ) + np.testing.assert_allclose( + res_u_seeds, + res_u_seeds_FD, + atol=1e-4, + err_msg=f" res_u w.r.t. {surf_key}:{mesh_key}", + ) + + def test_rev_mesh(self): + np.random.seed(111) + num_gamma = self.ovl_solver.get_mesh_size() + res_u_seeds_rev = np.random.rand(self.ovl_solver.NUMAX, num_gamma) + + self.ovl_solver.clear_ad_seeds_fast() + + mesh_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(res_u_seeds=res_u_seeds_rev)[2] + self.ovl_solver.clear_ad_seeds_fast() + + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + res_u_seeds_fwd = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds}} + )[6] + + # do dot product + res_sum = np.sum(res_u_seeds_rev * res_u_seeds_fwd) + mesh_sum = np.sum(mesh_seeds_rev[surf_key][mesh_key] * mesh_seeds) + + # print(f"res wrt {surf_key}:{mesh_key}", "rev", geom_sum, "fwd", res_sum) + + np.testing.assert_allclose( + res_sum, + mesh_sum, + atol=1e-14, + err_msg=f"res_u w.r.t. {surf_key}:{mesh_key}", + ) + self.ovl_solver.clear_ad_seeds_fast() + +class TestStabDerivDerivsPartials(unittest.TestCase): + def setUp(self): + # self.ovl_solver = OVLSolver(geo_file=geom_file, mass_file=mass_file) + # self.ovl_solver = OVLSolver(geo_file=geom_file) + self.ovl_solver = OVLSolver(input_dict=input_dict) + # self.ovl_solver = OVLSolver(geo_file="geom_files/rect.avl") + self.ovl_solver.set_variable("alpha", 45.0) + self.ovl_solver.set_variable("beta", 45.0) + self.ovl_solver.execute_run() + self.ovl_solver.clear_ad_seeds_fast() + + def tearDown(self): + # Get the memory usage of the current process using psutil + process = psutil.Process() + mb_memory = process.memory_info().rss / (1024 * 1024) # Convert bytes to MB + print(f"{self.id()} Memory usage: {mb_memory:.2f} MB") + + def test_fwd_mesh(self): + # this one is broken start here + np.random.seed(111) + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds = np.random.rand(*arr.shape) + + sd_d = self.ovl_solver._execute_jac_vec_prod_fwd(mesh_seeds={surf_key: {mesh_key: mesh_seeds}})[3] + + sd_d_fd = self.ovl_solver._execute_jac_vec_prod_fwd( + mesh_seeds={surf_key: {mesh_key: mesh_seeds}}, mode="FD", step=5e-8 + )[3] + + for deriv_func in sd_d: + sens_label = f"{deriv_func} wrt {surf_key}:{mesh_key:5}" + + # print(f"{sens_label} AD:{sd_d[deriv_func]} FD:{sd_d_fd[deriv_func]}") + # quit() + tol = 1e-10 + # print(f"{deriv_func} wrt {surf_key}:{mesh_key}", "fwd", fwd_sum, "rev", rev_sum) + if np.abs(sd_d[deriv_func]) < tol or np.abs(sd_d_fd[deriv_func]) < tol: + # If either value is basically zero, use an absolute tolerance + # this is basiccally saying if one is less than 1e-10 the other must be less than 5e-7 + np.testing.assert_allclose( + sd_d[deriv_func], + sd_d_fd[deriv_func], + atol=5e-7, + err_msg=sens_label, + ) + else: + np.testing.assert_allclose( + sd_d[deriv_func], + sd_d_fd[deriv_func], + rtol=5e-3, + err_msg=sens_label, + ) + + def test_rev_mesh(self): + np.random.seed(111) + sd_d_rev = {} + for deriv_func in self.ovl_solver.case_stab_derivs_to_fort_var: + sd_d_rev[deriv_func] = np.random.rand(1)[0] + + mesh_seeds_rev = self.ovl_solver._execute_jac_vec_prod_rev(stab_derivs_seeds=sd_d_rev)[2] + self.ovl_solver.clear_ad_seeds_fast() + + for surf_key in self.ovl_solver.surf_mesh_to_fort_var: + for mesh_key in self.ovl_solver.surf_mesh_to_fort_var[surf_key]: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + mesh_seeds_fwd = np.random.rand(*arr.shape) + + sd_d_fwd = self.ovl_solver._execute_jac_vec_prod_fwd( + con_seeds={}, mesh_seeds={surf_key: {mesh_key: mesh_seeds_fwd}} + )[3] + + for deriv_func in self.ovl_solver.case_stab_derivs_to_fort_var: + # use dot product test as design variables maybe arrays + rev_sum = np.sum(mesh_seeds_rev[surf_key][mesh_key] * mesh_seeds_fwd) + + fwd_sum = 0.0 + for deriv_func in sd_d_fwd: + fwd_sum += sd_d_rev[deriv_func] * sd_d_fwd[deriv_func] + + # # print(mesh_seeds_rev) + tol = 1e-13 + # print(f"{deriv_func} wrt {surf_key}:{mesh_key}", "fwd", fwd_sum, "rev", rev_sum) + if np.abs(fwd_sum) < tol or np.abs(rev_sum) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + fwd_sum, + rev_sum, + atol=1e-14, + err_msg=f"deriv_func {deriv_func} w.r.t. {surf_key}:{mesh_key}", + ) + else: + np.testing.assert_allclose( + fwd_sum, + rev_sum, + rtol=1e-12, + err_msg=f"deriv_func {deriv_func} w.r.t. {surf_key}:{mesh_key}", + ) + + +if __name__ == "__main__": + unittest.main() diff --git a/tests/test_mesh_totals.py b/tests/test_mesh_totals.py new file mode 100644 index 0000000..d12ae04 --- /dev/null +++ b/tests/test_mesh_totals.py @@ -0,0 +1,485 @@ +# ============================================================================= +# Extension modules +# ============================================================================= +from optvl import OVLSolver + +# ============================================================================= +# Standard Python Modules +# ============================================================================= +import os +import psutil + +# ============================================================================= +# External Python modules +# ============================================================================= +import unittest +import numpy as np +import pickle + + +base_dir = os.path.dirname(os.path.abspath(__file__)) # Path to current folder +geom_dir = os.path.join(base_dir, "..", "geom_files") +rect_file = os.path.join(geom_dir, 'rect_with_body.pkl') +with open(rect_file, 'rb') as f: + input_dict = pickle.load(f) + +class TestTotals(unittest.TestCase): + # TODO: beta derivatives likely wrong + + def setUp(self): + self.ovl_solver = OVLSolver(input_dict=input_dict) + self.ovl_solver.set_variable("alpha", 5.0) + self.ovl_solver.set_variable("beta", 0.0) + self.ovl_solver.set_parameter("Mach", 0.8) + self.ovl_solver.execute_run() + + def tearDown(self): + # Get the memory usage of the current process using psutil + process = psutil.Process() + mb_memory = process.memory_info().rss / (1024 * 1024) # Convert bytes to MB + print(f"{self.id()} Memory usage: {mb_memory:.2f} MB") + + def finite_dif(self, con_list, geom_seeds, mesh_seeds, param_seeds, ref_seeds, step=1e-7): + con_seeds = {} + + for con in con_list: + con_seeds[con] = 1.0 + self.ovl_solver.set_variable_ad_seeds(con_seeds, mode="FD", scale=step) + self.ovl_solver.set_geom_ad_seeds(geom_seeds, mode="FD", scale=step) + self.ovl_solver.set_mesh_ad_seeds(mesh_seeds, mode="FD", scale=step) + self.ovl_solver.set_parameter_ad_seeds(param_seeds, mode="FD", scale=step) + self.ovl_solver.set_reference_ad_seeds(ref_seeds, mode="FD", scale=step) + + self.ovl_solver.avl.update_surfaces() + self.ovl_solver.avl.get_res() + self.ovl_solver.avl.exec_rhs() + self.ovl_solver.avl.get_res() + self.ovl_solver.avl.velsum() + self.ovl_solver.avl.aero() + # self.ovl_solver.execute_run() + coef_data_peturb = self.ovl_solver.get_total_forces() + consurf_derivs_peturb = self.ovl_solver.get_control_stab_derivs() + stab_deriv_derivs_peturb = self.ovl_solver.get_stab_derivs() + body_axis_deriv_petrub = self.ovl_solver.get_body_axis_derivs() + body_forces_peturb = self.ovl_solver.get_body_forces() + + self.ovl_solver.set_variable_ad_seeds(con_seeds, mode="FD", scale=-1 * step) + self.ovl_solver.set_geom_ad_seeds(geom_seeds, mode="FD", scale=-1 * step) + self.ovl_solver.set_mesh_ad_seeds(mesh_seeds, mode="FD", scale=-1 * step) + self.ovl_solver.set_parameter_ad_seeds(param_seeds, mode="FD", scale=-1 * step) + self.ovl_solver.set_reference_ad_seeds(ref_seeds, mode="FD", scale=-1 * step) + + self.ovl_solver.avl.update_surfaces() + self.ovl_solver.avl.get_res() + self.ovl_solver.avl.exec_rhs() + self.ovl_solver.avl.get_res() + self.ovl_solver.avl.velsum() + self.ovl_solver.avl.aero() + # self.ovl_solver.execute_run() + + coef_data = self.ovl_solver.get_total_forces() + consurf_derivs = self.ovl_solver.get_control_stab_derivs() + stab_deriv_derivs = self.ovl_solver.get_stab_derivs() + body_axis_deriv = self.ovl_solver.get_body_axis_derivs() + body_forces = self.ovl_solver.get_body_forces() + + body_func_seeds = {} + for body in body_forces: + body_func_seeds[body] = {} + for key in body_forces[body]: + body_func_seeds[body][key] = (body_forces_peturb[body][key] - body_forces[body][key]) / step + + + func_seeds = {} + for func_key in coef_data: + func_seeds[func_key] = (coef_data_peturb[func_key] - coef_data[func_key]) / step + + consurf_derivs_seeds = {} + for func_key in consurf_derivs: + consurf_derivs_seeds[func_key] = (consurf_derivs_peturb[func_key] - consurf_derivs[func_key]) / step + + stab_derivs_seeds = {} + for func_key in stab_deriv_derivs: + stab_derivs_seeds[func_key] = (stab_deriv_derivs_peturb[func_key] - stab_deriv_derivs[func_key]) / step + + body_axis_derivs_seeds = {} + for deriv_func in body_axis_deriv: + body_axis_derivs_seeds[deriv_func] = ( + body_axis_deriv_petrub[deriv_func] - body_axis_deriv[deriv_func] + ) / step + + return func_seeds, consurf_derivs_seeds, stab_derivs_seeds, body_axis_derivs_seeds + + def test_aero_constraint(self): + # compare the analytical gradients with finite difference for each constraint and function + func_vars = self.ovl_solver.case_var_to_fort_var + stab_derivs = self.ovl_solver.case_stab_derivs_to_fort_var + body_axis_derivs = self.ovl_solver.case_body_derivs_to_fort_var + sens_funcs = self.ovl_solver.execute_run_sensitivities(func_vars) + sens_sd = self.ovl_solver.execute_run_sensitivities([], stab_derivs=stab_derivs, print_timings=False) + sens_bd = self.ovl_solver.execute_run_sensitivities([], body_axis_derivs=body_axis_derivs, print_timings=False) + + for con_key in self.ovl_solver.con_var_to_fort_var: + # for con_key in ['beta']: + func_seeds, consurf_deriv_seeds, stab_derivs_seeds, body_axis_derivs_seeds = self.finite_dif( + [con_key], {}, {}, {}, {}, step=1.0e-5 + ) + + # for func_key in func_vars: + for func_key in ['CX']: + ad_dot = sens_funcs[func_key][con_key] + fd_dot = func_seeds[func_key] + + # print(f"{func_key} wrt {con_key}", "AD", ad_dot, "FD", fd_dot) + rel_err = np.abs((ad_dot - fd_dot) / (fd_dot + 1e-20)) + + # print(f"{func_key:5} wrt {con_key:5} | AD:{ad_dot: 5e} FD:{fd_dot: 5e} rel err:{rel_err:.2e}") + + tol = 1e-8 + if np.abs(ad_dot) < tol or np.abs(fd_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + fd_dot, + atol=1e-9, + err_msg=f"func_key {func_key} w.r.t. {con_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + fd_dot, + rtol=5e-5, + err_msg=f"func_key {func_key} w.r.t. {con_key}", + ) + + for func_key in stab_derivs: + ad_dot = sens_sd[func_key][con_key] + func_dot = stab_derivs_seeds[func_key] + + rel_err = np.abs(ad_dot - func_dot) / np.abs(func_dot + 1e-20) + + # print( + # f"{func_key} wrt {con_key} | AD:{ad_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + + tol = 1e-8 + if np.abs(ad_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + func_dot, + atol=5e-8, + err_msg=f"{func_key} wrt {con_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + func_dot, + rtol=5e-4, + err_msg=f"{func_key} wrt {con_key}", + ) + + for func_key in body_axis_derivs_seeds: + ad_dot = sens_bd[func_key][con_key] + func_dot = body_axis_derivs_seeds[func_key] + + rel_err = np.abs(ad_dot - func_dot) / np.abs(func_dot + 1e-20) + + # print( + # f"{func_key} wrt {con_key} | AD:{ad_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + + tol = 1e-7 # SAB: Had to increase this a bit to get test to pass for MESHES (dCn/dv wrt beta) + if np.abs(ad_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + func_dot, + atol=2e-8, + err_msg=f"{func_key} wrt {con_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + func_dot, + rtol=1e-3, + err_msg=f"{func_key} wrt {con_key}", + ) + + def test_mesh(self): + # compare the analytical gradients with finite difference for each + # geometric variable and function + + surf_key = list(self.ovl_solver.surf_mesh_to_fort_var.keys())[0] + mesh_vars = self.ovl_solver.surf_mesh_to_fort_var[surf_key] + # geom_vars += self.ovl_solver.surf_mesh_to_fort_var[surf_key] + cs_names = self.ovl_solver.get_control_names() + + consurf_vars = [] + for func_key in self.ovl_solver.case_derivs_to_fort_var: + consurf_vars.append(self.ovl_solver._get_deriv_key(cs_names[0], func_key)) + + func_vars = self.ovl_solver.case_var_to_fort_var + stab_derivs = self.ovl_solver.case_stab_derivs_to_fort_var + body_axis_derivs = self.ovl_solver.case_body_derivs_to_fort_var + + sens = self.ovl_solver.execute_run_sensitivities( + func_vars, + consurf_derivs=consurf_vars, + stab_derivs=stab_derivs, + body_axis_derivs=body_axis_derivs, + print_timings=False, + ) + + # for con_key in self.ovl_solver.con_var_to_fort_var: + sens_FD = {} + for surf_key in self.ovl_solver.surf_geom_to_fort_var: + sens_FD[surf_key] = {} + for mesh_key in mesh_vars: + arr = self.ovl_solver.get_mesh(self.ovl_solver.get_surface_index(surf_key)).reshape(-1,3) + np.random.seed(arr.size) + rand_arr = np.random.rand(*arr.shape) + rand_arr /= np.linalg.norm(rand_arr) + + func_seeds, consurf_deriv_seeds, stab_derivs_seeds, body_axis_derivs_seeds = self.finite_dif( + [], {}, {surf_key: {mesh_key: rand_arr}}, {}, {}, step=1.0e-7 + ) + + for func_key in func_vars: + mesh_dot = np.sum(sens[func_key][surf_key][mesh_key] * rand_arr) + func_dot = func_seeds[func_key] + + rel_err = np.abs(mesh_dot - func_dot) / np.abs(func_dot + 1e-20) + + # print( + # f"{func_key:5} wrt {surf_key}:{mesh_key:10} | AD:{mesh_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + tol = 1e-7 + if np.abs(mesh_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + mesh_dot, + func_dot, + atol=1e-4, + err_msg=f"{func_key:5} wrt {surf_key}:{mesh_key:10}", + ) + else: + np.testing.assert_allclose( + mesh_dot, + func_dot, + rtol=5e-3, + err_msg=f"{func_key:5} wrt {surf_key}:{mesh_key:10}", + ) + + for func_key in consurf_vars: + # for cs_key in consurf_vars[func_key]: + mesh_dot = np.sum(sens[func_key][surf_key][mesh_key] * rand_arr) + func_dot = consurf_deriv_seeds[func_key] + + # rel_err = np.abs(mesh_dot - func_dot) / np.abs(func_dot + 1e-20) + # print( + # f"{func_key} wrt {surf_key}:{mesh_key:10} | AD:{mesh_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + + tol = 1e-8 + if np.abs(mesh_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + mesh_dot, + func_dot, + atol=1e-4, + err_msg=f"{func_key} wrt {surf_key}:{mesh_key:10}", + ) + else: + np.testing.assert_allclose( + mesh_dot, + func_dot, + rtol=6e-3, + err_msg=f"{func_key} wrt {surf_key}:{mesh_key:10}", + ) + + for func_key in stab_derivs_seeds: + mesh_dot = np.sum(sens[func_key][surf_key][mesh_key] * rand_arr) + func_dot = stab_derivs_seeds[func_key] + + rel_err = np.abs(mesh_dot - func_dot) / np.abs(func_dot + 1e-20) + + # print( + # f"{func_key} wrt {surf_key}:{mesh_key:10} | AD:{mesh_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + + tol = 5e-7 + if np.abs(mesh_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + mesh_dot, + func_dot, + atol=5e-9, + err_msg=f"{func_key} wrt {surf_key}:{mesh_key:10}", + ) + else: + np.testing.assert_allclose( + mesh_dot, + func_dot, + rtol=6e-3, + err_msg=f"{func_key} wrt {surf_key}:{mesh_key:10}", + ) + + for func_key in body_axis_derivs_seeds: + mesh_dot = np.sum(sens[func_key][surf_key][mesh_key] * rand_arr) + func_dot = body_axis_derivs_seeds[func_key] + + rel_err = np.abs(mesh_dot - func_dot) / np.abs(func_dot + 1e-20) + + # print( + # f"{func_key} wrt {surf_key}:{mesh_key:10} | AD:{mesh_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + + tol = 1e-6 + if np.abs(mesh_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + mesh_dot, + func_dot, + atol=5e-8, + err_msg=f"{func_key} wrt {surf_key}:{mesh_key:10}", + ) + else: + np.testing.assert_allclose( + mesh_dot, + func_dot, + rtol=6e-3, + err_msg=f"{func_key} wrt {surf_key}:{mesh_key:10}", + ) + + def test_params(self): + # compare the analytical gradients with finite difference for each constraint and function + func_vars = self.ovl_solver.case_var_to_fort_var + stab_derivs = self.ovl_solver.case_stab_derivs_to_fort_var + + sens = self.ovl_solver.execute_run_sensitivities(func_vars, stab_derivs=stab_derivs) + + for param_key in self.ovl_solver.param_idx_dict: + func_seeds, consurf_deriv_seeds, stab_derivs_seeds, body_axis_derivs_seeds = self.finite_dif( + [], {}, {}, {param_key: 1.0}, {}, step=1.0e-6 + ) + + for func_key in func_vars: + ad_dot = sens[func_key][param_key] + fd_dot = func_seeds[func_key] + + # rel_err = np.abs((ad_dot - fd_dot) / (fd_dot + 1e-20)) + # print(f"{func_key:5} wrt {param_key:5} | AD:{ad_dot: 5e} FD:{fd_dot: 5e} rel err:{rel_err:.2e}") + + tol = 1e-13 + if np.abs(ad_dot) < tol or np.abs(fd_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + fd_dot, + atol=1e-5, + err_msg=f"func_key {func_key} w.r.t. {param_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + fd_dot, + rtol=5e-4, + err_msg=f"func_key {func_key} w.r.t. {param_key}", + ) + + for func_key in stab_derivs_seeds: + ad_dot = sens[func_key][param_key] + func_dot = stab_derivs_seeds[func_key] + + # rel_err = np.abs(ad_dot - func_dot) / np.abs(func_dot + 1e-20) + # print( + # f"{func_key:20} wrt {param_key:10} | AD:{ad_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + + tol = 1e-8 + if np.abs(ad_dot) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + func_dot, + atol=1e-7, # SAB: Needed to reduce this a bit for test to pass for MESHES (lateral parameter wrt Z cg) + err_msg=f"{func_key} wrt {param_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + func_dot, + rtol=1e-4, + err_msg=f"{func_key} wrt {param_key}", + ) + + def test_ref(self): + # compare the analytical gradients with finite difference for each constraint and function + func_vars = self.ovl_solver.case_var_to_fort_var + stab_derivs = self.ovl_solver.case_stab_derivs_to_fort_var + + sens = self.ovl_solver.execute_run_sensitivities(func_vars, stab_derivs=stab_derivs) + + for ref_key in self.ovl_solver.ref_var_to_fort_var: + # for con_key in ['beta']: + func_seeds, consurf_deriv_seeds, stab_derivs_seeds, body_axis_derivs_seeds = self.finite_dif( + [], {}, {}, {}, {ref_key: 1.0}, step=1.0e-5 + ) + + for func_key in func_vars: + ad_dot = sens[func_key][ref_key] + fd_dot = func_seeds[func_key] + + # print(f"{func_key} wrt {con_key}", "AD", ad_dot, "FD", fd_dot) + rel_err = np.abs((ad_dot - fd_dot) / (fd_dot + 1e-20)) + + # print(f"{func_key:5} wrt {ref_key:5} | AD:{ad_dot: 5e} FD:{fd_dot: 5e} rel err:{rel_err:.2e}") + + tol = 1e-13 + if np.abs(np.linalg.norm(ad_dot)) < tol or np.abs(fd_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + fd_dot, + atol=1e-5, + err_msg=f"func_key {func_key} w.r.t. {ref_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + fd_dot, + rtol=5e-4, + err_msg=f"func_key {func_key} w.r.t. {ref_key}", + ) + + for func_key in stab_derivs_seeds: + ad_dot = sens[func_key][ref_key] + func_dot = stab_derivs_seeds[func_key] + + # rel_err = np.abs(ad_dot - func_dot) / np.abs(func_dot + 1e-20) + + # print( + # f"{func_key} wrt {var_key:5} wrt {ref_key} | AD:{ad_dot: 5e} FD:{func_dot: 5e} rel err:{rel_err:.2e}" + # ) + tol = 1e-8 + if np.abs(np.linalg.norm(ad_dot)) < tol or np.abs(func_dot) < tol: + # If either value is basically zero, use an absolute tolerance + np.testing.assert_allclose( + ad_dot, + func_dot, + atol=1e-9, + err_msg=f"{func_key} wrt {ref_key}", + ) + else: + np.testing.assert_allclose( + ad_dot, + func_dot, + rtol=1e-4, + err_msg=f"{func_key} wrt {ref_key}", + ) + + +if __name__ == "__main__": + unittest.main() + diff --git a/tests/test_partial_derivs.py b/tests/test_partial_derivs.py index c1c02d6..2edbda4 100644 --- a/tests/test_partial_derivs.py +++ b/tests/test_partial_derivs.py @@ -14,7 +14,7 @@ # ============================================================================= import unittest import numpy as np -import pickle + base_dir = os.path.dirname(os.path.abspath(__file__)) # Path to current folder @@ -23,15 +23,11 @@ geom_file = os.path.join(geom_dir, "aircraft_L1_with_body.avl") # mass_file = os.path.join(geom_dir, "aircraft.mass") # rect_file = os.path.join(geom_dir, 'rect.avl') -# rect_file = os.path.join(geom_dir, 'rect_with_body.avl') -rect_file = os.path.join(geom_dir, 'rect_with_body.pkl') -with open(rect_file, 'rb') as f: - input_dict = pickle.load(f) +rect_file = os.path.join(geom_dir, 'rect_with_body.avl') class TestFunctionPartials(unittest.TestCase): def setUp(self): - # self.ovl_solver = OVLSolver(geo_file=rect_file) - self.ovl_solver = OVLSolver(input_dict=input_dict) + self.ovl_solver = OVLSolver(geo_file=rect_file) self.ovl_solver.set_variable("alpha", 25.0) self.ovl_solver.set_variable("beta", 5.0) self.ovl_solver.execute_run() diff --git a/tests/wing_mesh.npy b/tests/wing_mesh.npy deleted file mode 100644 index df1bec448afa04ae02593a8db8e62c2e7f2a0b00..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1976 zcmbW#F-yZh7{>7kPMsY50JlXUOR1oU(9KP8ad47g6CK1#A}->maMF+9H*nImpp%oE zAP9hXJDuq2wD;j7aiXi!cRJD4iLOrH=|orO(_