From fb9504003c240038c684090e863ba588cc6ad3c9 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 27 May 2026 13:56:31 -0500 Subject: [PATCH 1/4] Update the frequency sweep method --- images/frf_sweep_example_1.png | Bin 26315 -> 25343 bytes src/c/dynamics.h | 1 + src/c/dynamics_c_api.f90 | 9 +- src/dynamics_frequency_response.f90 | 151 ++++++++++++++-------------- test/c/dynamics_frf_tests.c | 7 +- test/dynamics_frf_tests.f90 | 8 +- 6 files changed, 92 insertions(+), 84 deletions(-) diff --git a/images/frf_sweep_example_1.png b/images/frf_sweep_example_1.png index 5f77a24319a6978cfdf6ca1c82871c2afcec3764..ec761fbfd45ec76c2d68ef5a87893c043fe940a3 100644 GIT binary patch literal 25343 zcmb@uWmFtp*e%#Vf&`b~?(P~ac!HDQ?(Xi8;O=fASa5e5cbDK6+#7eB;+?tQkNGic z?pn9W>XWXbs!ktyWbbDarYJ9k`~m+12n0g@`bGR32n6j90zu`&Ljy;cJz<7`2G&qU zN*wh1_VWu|lmG&eg1(B2D7$AKuexb}-+O^O+oL4=yx>JgOZg`hGb#O#i)vVT9=LwC zq0tq$rAzPV#L=E%Y0Xe;AAFr$H+$3IGP(07zp;Fid>)GY1MOEr|KluHQPRwH5;!9a zj4z}cnUw3dBPo@mGz#utgaoz(;CdVgp@5F)8&3^Z04?ZWD5?M30gTTe7@(o_2f+f( z7Z4N@(8PkEae;;u>K!Z4e1?YC2O9r(Xq`X(EkdAO=TEN89rF?b_acld^mei z>I#|kafwiZ9q zJR&c^Y}vn4M$mujmcx81``c;If>8K7R)?!8Q}w5}M~f(u`x`vqfI#p#!L4=IqU-xoTD*R*3MZ%!BOZnuY@q%-^f(-(Z*YHqZ>-j}QCDAYVrnX%#vU}V73RzL2Ldq_ z@1rR=Id|tP^}4BzCw~2FVx;Esbl#KPQSuS_a&H27`8l1$?`?_=Rq$4Q(#n#r-6gD| zMc=}4Xf|{xvv~ZbmEnqt+eye;g@+NgT{|JPTzh-O9YjdBy+MFhyB`PU=Rxqb()>uk z%QO8rI+l!Jn?=&`d~v=tV8OYhWe2`q^E#b6aIRrMxmtWAtYQoZS?w8#jZ?*(A|u1F zelbPHK|mEDSs=t2*&)ed4B5i@5pZ;JBKP_ba$dU|Ln8b#qabYaeNd31$g^TC{oG1- zG0;UX>5m;J?P<(K_D2X_IjwewHw1WIz|WuJiaAE=C&hpHEwU_HQs z8j>Ywz!s@Wxs}mB=|Fc5DSGTLdt5czcGZAI-7*=hgUr1K^y~whW(~Xy%Ov%9UH+UR zryJzGlg%)DQIVwgaaZLtEQ}Oo%82mu)eM_bX4FI(9oYQ?Tc%M;na8KCK{u%v_lu!= zIi3A8r|+TyS*XJN9=|(g7%JOp9CwBv9v%v0Qn0bHh0Z!*jMYdYc{81-otZ^foQpLS z@SAqU{Pf;F{ycuUo^F8|IJf>WZW3^7zHa-A5zK#@H2E5~zvkrf0l$fGtJ3ao!@8~Y z<4ONyh0xhO6{HBqfzWR&)L2b^(LNj>m&(_|M%BWCZc(L5K{$&(_416v7DC*6TcY)O zp(JI^$7H=PUr#!qG28dKiqd#FEn=s^B|AHoie=6sJ5FJ6 zWoo7yG*b2SJj(sLNz0HaJ;VDdc@yVv3|jiUU6Cq!udXLY&zp*^XTI-mCbR?8u12Ox ztEwNgM*A-2Ui3KUKu`jNj?J0J^a~kV12Gd?-BRl7=9@^6l{%JoRCk`eq0{itiEa-= ztDzcI!hu=K>k6IL%&aVQQ8qTV_wV1QJJw|siWO8?s>Gj}`lG8pERp%Zr}H8kAPqd3 z9mZ4`0-J!2j;=?2uUHGu)tOOrv&@J+5N)&9K8`mnPdL!3?4ia;!!T>Ld~vE8{^M7O zAV2rR8ZAFfa6~WFw?H(}X$&wla0+I2QJs&%rr%s)>})A=Dx2c+_lF=+@;LJfOCGQ| zxe_fF?CEs-u{jm4SE>ydkv`ELveKLwBaFHwt6gV4bs$`WCogZbEBN%cNJ`D_*|M(< zuj50Z0`evA)3I@x{3nK$%j^3MjvhgU93imz)Nh_Ocd>$R;HQfbJ@50rzs29VShhDd za*M_Km^4C*YUQ2?kIMoR6R`q@ewOv(7u%xz?nznWNtI^JE#kHx3%P4Yx}mMN9mF;- z`7)*9vl422Kv3P#SbwnbMr59a@VLx)IzhIZtGGQ zJn!3m@1`m%kyxKDdr*b%9v;X8fByUlY#r`y7uX)-f=Z%kp3T_gP;?A4GP>y7>utc; zot0&`i??wNk-T& zew7$<1M56UDFIJLMuJHW%uBa}EC?wpVm{7au@+f(XJ?aL_50hn9$Gu}fJ}k;)slI!nz8yO>0nOn%} zh+(zs>6*{>AiB{(=_;oj(JF^~XBiM#;KIl}um<@~ z>cz_`+>P;yMSFE>Gov0}w9ziO;PAp8h*N={Gsy3*@ZWt&G+$!-+C>fc<=iwTU5VY97?U< zDTE3)7|<{0m{?B*XqK+J4TwLe^%M8jCvp%DLIqAG-CZX&i8I%-D z+$r9D;7nFPWw=@|K_TM&CDd6}?%IGwuSep`LcMeg^^tAn!Eyhn{BTmCQ_xfU;~i~A zQ%F`~gc%}dqfs#%bu`ow)*#)YwXx7*B2WJ6`()tPyxDnpp*n*zTU5b^vx#TbN-@GO zcl8YK8CisHA9L>S2H)55-pe37KRzu%c>+^gQ&V$)xo5Z9Qs3ClqmM|LWP5=&yTlW9v)Py3_d4{TdlHRa$+WcZK|I2IbmbSj_lG6#b9ecTT}7UfJ2T#WMt;yxm~?o z6TS|C-vGnsMTKiE@a?c1sWGm&72gaxC3rbF@0yOZeX$G38^Z^D`O#c?!WT+L?4tw) zA$0h6Faqw1Z3>sZ+QMI*I9W+klGT)!v zqM`x}%gJJ`Szq`^u?k#HdrW2HMInt_tSsp=7cVXk0Lhv zU(=gwa~qa~4KwEt$58z)mg^@?UK>-lwuW*4RsDYP^zv%7TW<%9aY;!@v(p|n78VkX zPn;1?RF7j7u$>Q>-&05btTo@HKC8hY`aGjLJ*aP zu^eH)^K~J;>n@g#BD)WlY%K}>pu@w%WG1Z!mm|Qd@z||-Z}x^wE|#(T<947T`c zFL92tL-i@?qo~_eGmDBXi+h-3usc{F#UzY=jU+Bkc?XJ297$p6XlA;;&Fdg-!!b}_ zc?w)sV%SpsZ`JtdrXFB|m&P;sF7LKt)KpXeXX*2J(kPS6SS>l$NF(0DKU1#6{tG4i z%Kw^s4R?yxn8qhzT%!ALD_H-;z%uLHLIZYUu(Q6p2)9`Wh?U&&*vnh5TmMO(#+jT! zR=Lgjo~2gG=jTspv3UqrB%Y3FiH9L+AobWYxT(NLY}p*4=UWQlse>!C93R&uevQ)g z)hw{fNvuM8*p|Dd=2CYMVrfYUq~rDF=TB&c0v1u)!GMGQKv07d7J|N`MV69CV(59$ z?f8b9-KC@kY)k@S>0$-q!SPF(NBE7PWP~U@8KwNLeu(NS_`BcyzL$b_Lf;e#$)rIW zA$XqVWw?56-$g2}sa8D_?T``M4NC;{J#jTB5^CT)Pbx+}%|UMy|K<9UCN5#5#szv^ z4dt%PyEGWR%{jAD0~j|=EiDq?yN!vvW)Uf^<{ z%&ewc|4SzTtNHo;5puiy>enb)e$;Qt_YdI*GLFezTMtam_Wa$we^gSQnn8l^@HO1@ zA!q%3)8P`2n5nmgcvXoP0_xnE!Z~S)?~3*R3y71?5M9+ zp}k?x3r|Kuk^^*Ivudf6S{+#2&`zCy$@r70B!7tiH|QfYwhDeHEC^ zJ#-&HwX{jYV6WT4_Scw_a3EA#W~KWk8Hjm# zJpvBI_u-(Z+Gs$t0wQUWS<%UQwY0KPaRRL@8AoP*g1MLWNpA7fpB$;DDlsvUEOOgC z$M0b6K7v)&$_3ZKkwQ)a$R4Aznuoq9!Qd|~`XPT&r~16PUDs;H)#e5*!C=tms6*q3 zE(-LpY#}$Z!vY@bLl6+lYtPzxhKc`Hq(xdQ@WGR=I>6X=yf>QYz`*_VP>`ZqQbK!) zLd4;F!q0Ll$aa!@Eu|Z(Hgd$}1Qsjp2|~ot^?SYsYzN>~0ISsV`h4ogbzpUp(=)>% zmK}*mERWDr8329xCk96%WKiu$;IPYxk0wyn%7R9&GP5;FZxgG zl}_3!-MD_leV*YJH?i01O<$P5FfpoDF;447H>AQQN@po^!HLPq@jCBE{!~`3w|Uft z6ycmdo?x*EvXwB*y>=iYtiFMbuv5lTJMIHB*&tKD|C^l1weSMc=)p(ES=;_nBtmfX5 zrhov2Oy2X&2o}x!3z({aLa5!}+8|5>&bniK=(kdDh4QcVS1oBU?ca-W6@#o;P{)Mj@@0Va6pJTG1qX!Fl_!EbW3An98 zJ^sbny<)i)w-klk`#dbwmbn}V=54i4RDy+vy#^UFuL%V`6GwK|+B}?gN7Fn!JOqd* z$gfFK<#>>B$*r7ALk0$=O>|)9SN6e+&+=$%A^r3PKp3S@t&P>6J*+5sy!T^;&n~Y!B z7t%dMuvY)qs#v)MN7vl|h-^9WZ3d!=?Aq@OKdP-G0jW;1TXBG3s<8^ly!P#}A!OAF z+=#3~u6ALpJUZb$-aGcyc}D0M#26;j<}WoKpEPbeY5#>@TwZQ%ZVp!T{reQ&_jv1l zJwd@2RHFq?Mjdc&Z;fj=6@U&Ugh(PAyZZomeTrR1V<#N-!;b*mLgKLqo*g_#VlogII7X*Zb z%JOV&TF%Lu59gk#3bN?nOj=x>uTEf&-aBekcoMC(vdA+BgG=lxYDb5pnw^+a?_^=S zxOuSmJ$ueXWkp3cr^Pg2jDr1iDfIo0UEuLS|Mr2<_~vvy=VJGWr}PM2RH$NHVIne< z82>XWveDo;+_(;}M^Eebx*UIl!v^e#wyQ8q8r4c&rj!vJCe14VVgMGLM*hM^X}nwc z{qEtSnprFWQAso`rTG(A_5AE7LMa)8;=##$*xpiT9~9D=`5TG$!NJV-o^`c+*Y!_} zQsul=l-le007;Jb#ZW~>1z>khR$EhsD4qHebZ7o}oe$4d*puL3l)mHCht~|Tfd%5B zfv=Kc=@DQr+dQ&z1LFRpZ>TB+IH@Ih>Wm{}bmc1AjPwt?jR`Inu7QfFI7gKn3o}0j zTl4lb?JCrkQ}lfAyAfIb%pL-u7!Y5l_P(F+fB3`t&c<2|-b-W6=*zlvVXho&#k{ne}+GpR5ox;d7?2QJu+MKu3uFm`mQ@ar*xPyw;Q=Y z=e88#h{*9h#=Gji@pj$aV3k6)sJ*KJ!H7aghsckQ<9ZM-1314N;V4xo6lk;DKo*FL z)c^AQD0Sf?H`QS=oc?JR49-`E{m<;Upon1wx7%pV_TY@n z%=BuyjWy*)-n0OO8V7+|yU6SW+*O_zX6fEAqrq=?r=F8v=a-iND1~9L;q$~Hq!>n4fa>(imA^~L@8yu=`MhI4485#Y z=kY18QwL8w)z(<3@ekIUG3NgBT;cm9v9`+%HZaN^<;Y|ORB44J@sNd849l7#o0;HqcQ({1HStOk==cjK$LJV00gfpbl6qZEXThYxAFzrcbxmzy?*92#1+DXk=T0 zO63I3k8S;4oiNXVvc5W6g{w`D&DvhOj4Uh)PR(_7%FHPQZ8DEFc}Zs{jq92XDCxSV zI0QLi1O(DgYi#>hAp>yFH!lR@DUDZ+0obp6&OEA(PcK;g&kw+JLz-)Uv3S}l2_ zxArD-%&OJlbAdc6RtKk6Wu#SEunIl`<859a(40jJyLuE&;sIER$8?fRi9$Tgn~XXvca0zx8kP&_@M z-YE~)dKJ3zvQQBe9n2cKlhMB7h^equF+dk$o?H9cgJoi3!k}8VzrXJeY2E`cZNZvS zBW_;2s#OlRk9D+hDVq5%I*iy9y>hRne>ge;V-+~L8YKY19v%qHw>>12mcgbFX;{l3 z?`G$dORTf--#diOr;STsl%$=z>j6A`{Qc07=LTPAzGHWxa|LT!PLs6Rl#6Y=MRJxUk1!$WjYUFOli<~9>w@C-I{_03CMp_P@D*M4q@rIi(l`@bI(!mpXf zhai3b`w+6QzK0M5hj}FMazRH|!kf>Drt%PD0>F3CpDNEKow|S>VZ*TZ>(glAvat0>@D#~bidEbDNx zQ+HN`8-)Y|wvG-&yzK(rtLB88tk*Fwzh)lU@HzZy%^m)y!|w(WhrhqO`%=JNdy(rm z)AqVo?w4ImTEPA}1^`ZEUwaf2UsO-}zf*%Ch@DxfAd=rz&#% zLW11@xDMBkgniBH(Wb|%x2YqTx17M*&PY>J3Mw0kbRrDL@bJ#XC95Fy87tX04~*Sbv`mgw58|5MqX&A;Yo0~?VzlF-#@lRhDrf6 zzyOI~CWo24ynM8r>@#$RenBr=rD7T_1rwLXpVki%41+J!90q}Ko}~W8jKadg%*@fp znjjch+jIuK;Om{XIT8K+oG7MCR0+6VTqBBP}=6~*=CjD53>FopeIhUR+ z5?l+~!cC?+Vj-#P`5gFdjfK53RWTIVN#&c$UP69KDH6?jEw(OQ{{z&F=ws|`f?*{b|( z%a9ynJ_RxBv~W7@%EAUX>?zJ58sEp`qvyq%CDUeTvhCB|Hgey?C(;x;MB2KfBn@txrN7I|k4sjSi?$El zMg34|@rQ0=?)GAcdf*E=`gfk4pwyuKYhC(M;WW2{kc7QY%B%3XXTLh@&oPO08mgq% zY@EOVZ1?QO|3tE!=(KzMTOz{S$H#7^2}-IM%8IlYE;4qmy175zU0sSS41-U@D&L*C z^%TE<&j{Xg3Z$;;I``t|dz;r()-DBLc5=whdM(C_oSK*pij`3}ZJE%L6m4!mMgyNa zujjWqK7DIywD)}-XRn<*0AMPua9fBf%d)PlKW2G)6; zE`r^PVs*qK7QkLSqWg7T~JU^xlWC~-gL|D%V`ptUE{eE z_O}gVFm|poeQiw*nrK*9nDM+x)4%Uqp|X5NFb@3`e@_zyr?1-M7;GQx<@tWo^+*1W z1ZM%herIRLf>>2kv&1JF{iL;yWn|}Kdiq;{n+Sp;be|0Eorj%)=^>E6>W#|^o=vT* zT@><9J-$>C?;SmSVA&PcS{Jzc+r7mfU;M-ztlI6j=7&SZY1EID;ftdP?IP_CpoJj` zNxSSm+FG^HGOM0z6#OMJfL9AU zq$h637|6_SJm1;qWYBj;S>QZ+E^;3-b=S<%S@W@J2Lfah=QNEwC>dJogL;N+rql5m znUczUb7|k|A+X9rJJxHybRa7Tahq(gTiD8b)UtO^YF7$!$r%~t$x=JHx#fIvpx1UK}{kk0=iOskR%gT_*uq2NtTggF4adc3OK&(MQi_a0;Nr2LDc~gxdIu7PAL`{(Q+TF>TnKpFTmjQ+h!Re;eS0>F5W}dY zy*!7xv1Q0JfR$ESU5!qLg^MBWDp9td%Yw+mf=58I@zqtrUnLcz^NsbhIF=t1N)qGN zKkvi_qJTGm+{&O72+=E|=X^S{?w${$Zse&%Lw9=rMI&fend7xS-^8k^EqgYG3>$*kt$5=sV>IEpu%>n7x?Bcrz|xlS^l@;!T)ZCPoj1g-e5M_(s`jzBJJdY6+vYd zP15du@-(}-^}er!m<#C8W{vyi0u2UsOUt7<$~MvNOB`?;UteGN+@&SW8U{l=;A5va zP`nfS*~>*mVKQ~%CCg)b^u8bEqiATbL4v6F?%3|Qt3?i{U$qf)6}yD7F{S9f=L=s! zU1tzS)LZ<;4LGkaq?mi#FU+4x?Z?6Hxn<2!O>vkX`CLZ-sIZY?8qr+a=L<#w}pV67VG}}Ax4+&W4JP~Pf`|_oc3{`OyB%%$NkEt#g<03cE+03jQ&iW zOEI4FXb_Z^QhcN*zkx>N_)GHK(m#wyQm=<_66!IbdCN4)}ru>&L9G7d^dGyoB2UheI;@l zK5l{uInoM!Z=qn)fFH;++3QK`aXznmd=5HlL*>hdx0xny!eZqSwOs8ECjdFssj&|I zV2AGfQp6UJ_(gGZ{Wa^~_dmEy_E6KQew?9CPqE`Itar)~b&HLXuyyBY&MGJie3DszhgZN(wRLV=Ih|$=-<)Y`+tl*Y^^lVEJgh z(!?ex=yS0>1Xxrjm-^D&{fg|hY~7V81dcAsTGh>eiR5y77_B0x{R_*B4K`Z3y4kx1 z1qB5_!sn#&$b2&5*xXiE_xGQUB6Q-f=29^2?NvyI@7noI!9-(@(Amxi15OO;RpAUI ztBk92IYO9O`EEsQGji;)@kP(T)Y40dd3G)6Icaikj@x#HH*j+6cH)n4tg0Vr`M*6d z_bv0Ucl3#8H_LW0#;V^+NWLe zD`aQhFSVEnJxo;e6s0ncaLZG+itg6V7ec}Ok_KV!L17!C-nVu8ivonP4Wv~3bhLG# z_dQjXd;zgY~! zB~f&_Weml;yze*j7F6d3izT<<*r^o@>in7h?x?ORP57ZV6)4t19Fx|22ZadV%xqor3sj%O%;`-mXvxhW-$SC=ov>D4SZ7kZTz!*mAki z){j%j*4&WJ$$ysviWDcybpGaZq*xVcCI zR>BT9c2F0_9jK!$j!ax7zPkB6+@b9~BKZ5_FbLaBVJIto`l6(Qxc+7fMnIkIM|K`~ zbwIv3W=4a}Mmmxrup-N**Fd(XODDXvIVZ){`{^y$tO?e{SkJP3w-HvnC<&qRel__6(08wwd`0A{s^P4{reYsT?X8q|PN=iJQo z=~z!y7YR}s9JD&zyDG7%qt)yYmXb5V?^=%4U>TKf%brDII_uLVw~znCi-PX&Bd_hl zBQk`1omo$!NBM#WVzWXfT{vCfreA7LJ1aP9mazFm&2443kNiCRaWG97dZxy*1cfR9 z(8Kt@q~k>4HB3vxR^C8@qQbJ0xi!u0MDim80ggD|B5N=s=bh-$sSvNwJgUw1+4tD9JTKEr*Y)vn+zV!s&XtyY`pGm;X{lUc|>oP?UC|=en3` zMM{!iVoX>3VWld72f0rKbmR{zq$bw}Fa)WGR*P;G%)03ZZnL)1^YO7ZatpAPzEe=0 z*sRXf%G|GG3$+p?>_JB-)N5y=zTb~E+R(qLgI(rEbGU|_urlD6rVM`UB)Ooq6gr)q zB;%t%0EXBoGi{yZ$zURgAl{Sj&4u48M86!h4B))yZ~eqi7XPUiWsMUH?!RxI&J2-n zKHDR?_EoZ(9>FcYRWY-(B{fx0VskWooU@X{F+;a7wwSVWOu+srUyaRWw@lIR zRNf+Pq?eD?0g+LnmKTvMzoe8mL(N{1`t|xrC8-66Y`Z_7B_iT0?n%RbJMZlzTW`-7 zlC134#R3I2DFqZ4nrf6z2u#zdzkY&z9|%eowqA2}VPRqN?WL%urlzH(rKh(J{QvuR zF>QclNFLdNN$fOc2d}7$$ga#M9pGVq{AHPryIHJiq+2bJQ^Md$7ooq2t)4&~skOxK z2cB(VIT{eKz&kJ4>^B}YgJaTTjoG6|4GnetfGZ~ul$q_2vNRjk|Er7LoPE&+6aj?n zu}$z$0^LBd1i%$(X=(zjVtPgf*DDVf7uOAkxrHojPfywgkf|sf5$_y{44CVpZ#^%S zPzSj;xNSfZb`M?543O{?#eqFLy&~*qWlT7Xu2*bJZJR$+MVBjtxF8~f%|cvMW{>iL zh9?qAV_&MNc zeSK1sw7_U@w*_Z7w-dijiXn}o!)&;fQ?G>ST`4jEco9e;zTK}7;1is%(eJ4>I!MQ zfszPiq9DAldn(_!)k`Xs0AtCWE)dbBsv|w&qgtV4FI-MuGQ#!)&*a~Us^*3fUj5oc6^d2n%32}A~{1EMPEBZ~ZKHJuS<18&iiBO_+s>Jj53c5di^ zqvGa82-P>b`gT%EiM+Df%-^p~Be1BkbG zk8yAXhKrZiSA+WW-K7*R?OOQUb}3Eu1J{BN(MIQB#3liFuNcX-z5viagioUELLNSt z$Z6EO{VgBa8%bYg0RDODj0`hC>Wb5`PWq+ojo6>s1fDY$QyVil0w6;4pQ`dqEs^+1 zGgk`>k8JuY_`tZ^SCb2NpxYCX;)o39F*!p5Ka6**NnIW~w20}!KSNn8PPRK!&zEwj)9+z5nhqCf1&Z^@xc~-Q{ z(QEj_Z255`_cAFyvXhhHT?=cfynMyl3q;a~uCE>9EjdU@_M8pR$@66uSQmf)mos84dUPvPiK|VdY8GPj1TdmfKjrxo^4l|753fC& zuNE1lc4lHKENjctYm3uIb(utW+mVAyu@*AFeQq<8`%7#ag9pl2Yc4k*n%I*{EuY$4 zwA>);FXMNcB;vYGuQ#Waz6<9S{0R^>j{^bxXU&I>TGuuLWu3{@C3l9zBQ39_K?_ZB zYrDnSYF|b(qk89qh{l**0%q~LW|}Ou1mP2}(E~9`gV0af%lUh^;9Hcuc`xhO zBc{cBpHpy8Y}P3L^Pe9RMzuZ|F9Kl(PMku`TDA*Qv=+aprV&u zx!b!wPjNqN5$UB>kdE15J2Eb#(7#r8sRRr$@ZouRU1T0*{VMHpZZ7MwvE#d%s=v<5 z`q)3dtUjt{GL4OJNMpPG#6~v9}pAfs-?m9`OA4!@&@GSzTdXgBs=Bbk*X3+}5o1dT_~HFmn;; zuAf_B`UazJEQU_v&UijWV4Gd`v-L$ol3a&Z(jG8B4oOsAmd{(&AASQR7-0w)D|&(k zkR>MmTRT59?emz9`%%BW^={y6oYPOZ6_uh+c=`25>8+$)!Rw_2XXZrLd-gw04NUx3 zkb?abwrH8K+{IE#6!5>)R%|>S$Q43I!u8gyBWX3SQ8xw_riFO|v9fEWyQ9>^Gum2O z_``@Lt)GBmq8jP~t^0x`y&SCer0wy1;j3L&#CDT#&gQqA@Kl%0gazf!q=4O==uO4N zXr8_?iE;`BJ2VC!-DQdmbE?SUb12jmikbGwz}#bu#jvti4?4-O8-AS%B3b> z>JV@@?lEFmxZ#0gd=oG&J?b97)}Wt_NSjQ4N_;Q(Ho(fJ1#@K2vULFY3Dml4GgvMD zR|0>O8rdfOCNxu(bOnt7T7W*uqbrv;IYyXFzVR#qaHi^0O$;K#}I`|kwOrOdK+(Cb4kQgZYS9CtL0WRuHA4Jgy6dV#5S?|@@zoLt-;G$^EzCEZc z`WVDrwXFf@-O3tS@!uZ6fyH|v`&MwOofX9k%m3j`XIJHb1+Smqh)IPr4XD%nSMwzQ zQ}v+)AM@!0r#s0+{(q?amXQIp%T)o;VIA_)&S;A4DNPz~$D5q}g8I`L80?RVLUmQ2 z$feoI4f7^Qx|2BgMmXR=nDSO8f7eIouv-s(3xPpML!i)5`HV(oh)bg(>&oSihYUqR z7!S}dfPl$I_{AEk#(ZJH7!)xb-?wsQ2eD1*lYgMjiU=&mtND=w%lJXFtACK){f+(( zH$xn(2sa7{uA)Oo)AYNcG&V&|_#h&cV)okCP=R(~dbSkz!s+;aT`7bFnxySsm}GKqs?|Ml8G3gUrS;ep?m1ehemIMU_rh&|wb$czn1Kmo@Q)6n}l zt}<0XzVcZ94;q97EyTMWYjVc8eoytUfmX}E4n+|d{zsw;l(GqThA%VC@MI!4U@wR+ z#Ek~mV-eaMB)vb6cGi_kzRL1xq-G4%@33mLK<4w+F#qFK2mKW{q5m%V`zda zAY237=q=-UD3Cr8z%j6F7s@y#EO_1m3ntUJnv`HdmbAbW1los!(QkaysRX{uc$`*C z?rNPsF`==+CZ&`O(q#qZ{{X>u$`3`GgrW2JB*Zb>cGE+>iLGJ*g!~;qsq#}Xp`*GB z1G*|;)qD~K_TfHo1uz6}>R5k4f?py0>cH6O>j04YLNQR1_FOuJ^ifT@d>Ko{N6?-w8K`yN&+EUQ|m(XbyZY8lj+d)mTY&>pZl!d{{~ zdrRtSm64e~<+P1G^YyC@)44qX)BjMXv*sGfA#?>sx zQ7K}kPk?IsmF7c*UvoWHG2i)$5)zwaWl3T~-~^iWs>e&3yGLoupwq*%)%qX)stDbu zypdE7VR1pW#?qqp3f90NQ^9BD{vzp=WO6PVA%mp_%++vq3yX{r<+12WA(#B+i9Jaf zH?{4u@l8xY-7Bqf!C_i>I}m8d+AT5fRYZ!KDEJ)=KbFHz1kwCNChzykY=X}uUOZ2@ zHJ63j(N_j*mJmx4{s@<&O?Bb<^oL!P8*Ar0((d_!HjRS~l0RjYj*hMss2MM#>%xNo zzo}s6l|5ev_u2s7AIX}c5>|^$do}qR!C>nnTvEaMtJPpSS@3mmfxjG_?=u?NhhAYO zZH31bKW6iPB11|@<(Hwheh0j!?xbpt$HiV7$Ppj z@dGDZfqF5Yb#v64)_V|4&_qrA9;ssvYf6bRd3V>_<7_Z^Ks6Etk+HIj!A@23u1Won zy}Y?5zsY%0k;TsZy8|R|h&lS)g~{sB85u!MW!=@qbS^~B>(fpEW~IQw%%a1P)nQ3v z1CB8SSMBM$#@}uQ(QLmOYAfXvlaB0U3;vq|pS#MT@XZD`j%2x*r%UfRt?T-Rifm%n zwv27r)Q-I|>Von>PH#@y_vr!ONd1w~sSLe0RvEOv-~98}vy!gXbwY!(n?0+rj%8S^ zttRkL9EJ}DHvE6J06?YI&X}~FUQR0<^_XVDkp zJUi|>>e`=osQlchiLS@*2Y&o@dnKM%`W>2zuIKU;|LSvCLvFG?TJ&9r_xw<-4pNcs z>VoQpec2!MMGr?#Vac;gcC5i(eUdN{8p;~)%u0@~vi;#u`1M`^U`@Xk2D-h*s!EOJ zuQ%Zy?r6_0&Gtm2HdBkP{b(LdO<8+A>maeo@ZMS8Oy$aXU*T2pGN9y=axkVcyOlz& zp_@-4Gvh_<%et(mwZLhPBK-r@fCR7qxg|HKj@&Rbp#&7 z%#q1c4lx~bo6D#AgT*Ql|y@{(p!&IHfu&_sn9&{y_DS!t1?CqzcX-zHgqRw z3tayf+Ib=@D#Iu88CQ46t>X93sHxxn=MN;nBhO(k3GTl1%**HfPTL6@oYmRnu-FPA zd5(L+p(#xGWUMXLg~y9;Y5p%ygbs!MoeimS6gBI+suO^gBPJ#`o`)time)f1Ph~WNzCP815Hs z{+6W|RQ|Gc(OFFD-#l79e!LooMle7kL6-VV(F)y?Pi1(SO$sQ-+<@?hS`dzdl8TB- zSXl28_dh8Sr&>KA=Jb=VQpOqbSFgu@Yk1FuOB75$+FseQ*zuG7si@EN99OiuVxV4wUWb9J^;Dj0?@}h}gVONt>=%)FS z=i>b+S^T7?XjA8V`X?`Ney_b z?2|zv=clHa3Bze!uUo^X(ca7S{_+l%L!M?wr`c7hm$S-zGLz8P2f3CiKXwOcW^ZEn zym%?W1>n?}(B&kdn%;ZtO)rI|A6^DHY>wuF{vFZTO#bt*EIjoYN#Vq*Xn6L0 zq{nzFp+0a^q?`1+7KX}IOUd3{8S>6h!FxBovfAP=P8L}q8=Dm~N7W=}P;?MO=8U`T z9pg|pz7)a|p~{CVfhrE`j`9ox4oxfVd8|~S`dz1x@EQ3MGapY@wv)7j5}C(#tV>+W z>l{1!ms^`DFP#~hECZomZ?xf}pJO^=F3mK5wFJGt{`0@!ECBWe8B_SIi(H4`T~Z)a z6N89B8Ud|2W)6F@j*s)rWGjnvyM*lx4wpXz-Rj5BNiLsX9oUI1_gw%yw z4a6g|vqwo2`-Kr(a26GIOa*9&zv;$y__&yHfw6$7)v8WlHF0;G9iE8<-Xs-33ILtT zHY60Ubsnh*i4l@E?x`cmj7gbjI()6B^6UzCXhfme3;iLm&x~G(HBk&+%BnF^s|F`eLrAF|~oA(cs3navhON@E= zhC`!dF3L+MnCW49NAyiuK&}r297P1JaVQjj)q_iFWE>hAEza%&?Ju3+JsT$xJ!lmQ z+d^Vq%v%G-4#g?d#~I<{(|!d{pCwnHtd;RRJVue_^B>Z!vXko8anZENSBc(_%3egM z{Ie}kbIE0oq)bU}fank72cBpqGX3vHxS-*0I&_oiOpt7IYkbG_*Q)Be1wYhWH0UD0 zn-9A_87MRVF1uv!$Y%XlldOkuzG&yPi{=bs#5t#S5lA4ES@m&AfGDJF+qllH$uI%G z0^npCN{BL!0aQ)V+ofY*1ly*vpXdv#0m?#qi7v8iLw;~)IonKe0 z_x&?c#=wL45XklUBx<~+RB5#Mw9w|K4-AVrP`Hz7&4l~nURWqd%3*{gD9gBX>}NV9 zd>NDftV{>*7b!0Yq)Nuc3j->}7cH5d9Cb#k;0Woe)&Mto;wZ7lPCbj5hHbsYISy*e zwDrPsm*bQIcAQEkBVebK%o;WvZwBc9l36iw&(Zh%h!j~Qj@SVv;Her)W#A^GJDbfT z$2Z9yW@8hd&!>N@bffts=o}@gdSzyE49{BwGAJJ(hpi@E0Ntk>^L4ilyQAFs`5;gM z_ATz<=r%XSoUv$wh>e+I*o|ColPXIr?(!sj)dDvSh$5($L=KG9T;LQwei?O5rovWu z(53yNOqo!9pQwHA4<9BmbW!e)0IJHs+2cSCH4Sv1)Nw0q)qgarH%9LVC}eYF!zrxE z^y}6Ysv5&}`RvTpAj6az9TbqbQU5S=MbWSBej$c_IZmdG(W4z!ej=2!s+5zGEM2cRaRxuN2p^jUVU=n19K2A%V66>g+Q=^ixa- zMJApV4%>+B#=-WH26YnUxwPSMDRC;3A|1w&Uh4F z1}f8`(iw93wsv*Hn6wi{mJ7o@V1BhW@OJf5kM8pv=LsM@agT?9RbgGQXJ=y(m3^#t z&C8a17st<6?Y5`i=6jP{fR8f8eJ>ZKnK@6PoGieKlzx32#1f7jOb2-N=+SCH{(h|l zZPKK!;sz0%$XL-i>&<$H2qrE8FJSil);{Cr<$*dVt8c$4>m3_vIcD2|GI zN~N?Z#ZQG@i6%pE)W${F1{m)31lROXperYh?azKpp!JuYMJAlCkUnC}M<~AVZ~~(6 zK(8pqXel$M)unTIiXM=xGS#ACJmnpaF$!Nqq-t3+W!(IEMdUn`^T;-E6QETt;{d@o zTb8KxHH(M8wWV5K12_TTk^3|Ff3buM_DYa@K4YU^`F~&&4TWLDs!caj8pbJE zgIZ~&w$xO+8zZaRjA!lFmvdcQ!zNJhmpZK4zI%8KWB?gyE+;^eT^$0*E{M9aMD9kZUzVmaJlj-qkk|MW~O1riTc^uhPJu2M)7by`OM9ia5&+ z@rFF_Se9acL7^m4O&%bdwu`fJX#A9icQau_*Q%NE#su0~Ey2revMrzDXmf9P(@X+?RIsbg@tMDkaYb zJ$gy$0|LCvpLFiz4EQxexo`oMC}tyUVbf`HApH%LQ(TH0sD?qDcUm;BV9f(GbGVm0 z<{uM)^+Os)xP*m1OSLI^GNU^WxbN$}&z zqJVj<96|vrrLh|s)it_^w(JE)&PpISm?uqOBBk>Wh>gp}Fh%e{@^1FG5Vm~Ho4m9d zFp$?RGk14ODBQ|(?tE0ihO&dr-i}}bvH~0S8_Dh*&jH#i2xQ?0q7DePd=&r$0jE+= zuHHfRzqdE00%PN!-N|Y-!2e~2=*mt-9$OhVVTTp;%Q{1zA_iy1PyIMqic`41uj@K? z68wpW3DBiW{lFy&7+%4erkr6wz;%AG2di;-%r~;cH1wxBMn*vWj5tk$b-3{CWZ|mP zhe@;A<79u~?!NgXW$lmf_(Z~oYOEMqVS&xv=GdKpeg{MyW@zka@0(M(Z(mrY=Z=-~ z*xUGPLxdR_WuVhpfbhUAj^;g$5>SA;DmGR1t7DXwm5qIm!3?OE7(BXmWs6)j-QM%F z!ZYw8<=2r^PzY;-i%*zd*7BFHoZrnhoMl#*UgIsS)4yN3c>!-jfA<_`%3hLlP|JFW z*OjDh(0z2Gv;k@124O(D%T`TQE3o z*8$D>;(`#zgR7-ea$U{&+|~k*u796t8b5`z9U_Aa#q^{O-eF3hv2!Onz84uL&92B1 z-nn@a5Q9=ICl`uoFSX?1U|wR|Gp_$+B*_kA9B1fr zL3-{yK@8qje&$OOgO9nE@xL={=mW}Rwidcdi)1`6buz%>AHG7aKPGagL)bvtH9=~_ zmR01@2HqZh2dq&9kfFg$OIn9wE<(v#)|0OdU;XC^Km@TN5h5~P+(>Ou@!%Oqo3uPt zzG%Yg_$|)Rk%$A=7T>3mP=ah>#Vm9!;>%02zxo(DcVD0B| z$yG1AO}MCk7I42z-uD}S_7|r!b6vcR&qU2pkn-R_(100x14m5{LG@k3xrRC-ew9(x z_G@aW3Bd$Pdd<{eny3w<48TGGIQeNii~)eT=M1*NxQ{YLSA~6~8t7=LmarCvgFxsp z)pcKdFA5Gqj$JD$P!PVLQ~Z1DE)HeZmO|Nob@oipm*Y6_hdZRFIaVpHLqn4s6-?jY zL_o|53dpuWGNe>2XLqRasnKR&yB}nCu+2@{j6n5L1VbL9fe4eE|IM6CL|fOi-~Blx zifJZdsNb#J7}sK43rz7G5HdrQCKeXA1vS9I3pRuW(*-`KZj}b$GNBQ)&mT(+BD5!x zT>}yavrFSy4c(sN|2{^0LP#8cC5Y4(Vg2obQ7rBPZVado$(?_MNz2~CKn)DY!A{i7 zyR;UojXVSZ#s86-XLeYuVzTJL#6TeV*#md%QZS%B*$^u*k%(y{SbH6BbXG;i`_`e4 z(ese3zKauA!^jBfJ(!=H+qL+)mb(6~7d8w0qcR=l)+)R})wz#H<#7F5PDSU(9m%`D zbYe2oA8oKt{zlV!GIx3hIiRU;;bFxr*~x|PGU)5KyfH*hPWldzl@W*4H#jQ2W6v2QRof1i6oQ3T z)}wx7KsbH2>-u>W9@3`Wf>=`g0SD7Qg^lx^zRIX-IwO^-q@b5oFNP=3X68d}PJ%BbfEOvdf=YS3CF--`@4xQYciVHk}Gs-|#X<1Fw z+FZnz=#rYr9M-zY#hiuGOh?MO7;P0DSwr!U)34X3+pY+cwgcCtYRDlT+g?x$!xgu8 zG~ee5rm<8%2OPT;w8!a{2HT|85rLk6%1+uAhM67zdA&Y2XKS2ak(g$+X5lGph*nO| z;b`xoJB62J^7jgw6jml)(vR9k+77lIDcU{-4xYk5*$C}Ef)AgqtZi*Oh4$%zHwj_U zlN&t`OR)45rbjrBo>FfBH$NB1Z-4UDysuewr2jRRDW=}*#Lb|}$=zQ02y6=q+Tk4M zHxv1}WS_Cg#g#9WGZL-V0y5Jw(j!h5u)io`hRO|)H+Xxu zd&-})&`A?!hGkI!MNRIu?ZRqv5)q^UTOKP*vOGqoi7$t++Z6Md;tkSM8eOMF zb0+n*e!5a*afqt3V7&BvYol+Eh2aJ)*A?qIJJm{P*}yTR|I~#YYvh1pU0zqPgA>PB zXrI=5JACsWRO(0iIy!WM%G2lk+9z7TnX7AO1sN1VIj)()mzStC3(dUQw_m?D)O8Qo zpP62~-9LZ6nim$hpPsDxrVfUvw{?G2LzVtTm>})12 z(NFBEEE+0XC?7EkN(x1iJZ?W^gkjO)F2gW8QXHD=Y$iD-WfA~(UU4z|WEyC9(tNIl z3QyL}&CS#_Ydv}&uelMGPTHLe(Gtk}SE3qru$tsHsdR=lYvj)`{Tr+ORMCB`*S~aZ zOjEK~(V=I7%BH)TG*C4)H8Et?kjv7B0L6)!pTYXrH`bI)GD!V!d5=G!>qVDsX$WGg zL75t-<*pr47ffuYh9lw?-(xdF{nB~H)kr|0v@ocsU^ECoF(lw8j z2MYgmT(IetE1o5eIzwSjWAnbhU!PQezE$upMEn)lZ5B0BB^jSl)x19UavB_{PXBuH zOp>#~;om03yU4_O%^VUGVGH}?f|oMw5VNVcdfJ*AA8AY{3-7Q184r8QoEQ72QCSzv zbmuL#_EZ|3ShGsn2LBY@CG?B0T8buYnF0)N&rv7sPaD#zse5Xi)J0M(k(8<*J00d? zMn|TPW`ov*jo*_$+me@4WWq}799f>Z9r>GZeJje4gF2NaGi0UoCWn*N1f*NETDZPi z-K0Ix6n~a#u1c8lWA6B>{Y}(G??27P1KZi8@)xBqVSP9rYBYQ&mdF2+ z`(MqvtxV<8SbJL1Ba?Eq#6%spHn#tLDqOB`6NEH<(=kq&`kN^1x$bj!yyA6(kwQ7p z;gLIp`<_b}hX>I#nraR3Yi{EOV%u+l_wC*Vq ztMSoH`R8UX_|rvJZ7s>BWK(ot`QpCmmCIe<;K7$Rmi5#^k<=D-GEvi%5OVz%zVaqI zF|Fx;qq9v}^m)tSewrU`?xbBNf(kgG%1-@FS-C^ zxSFl7GI7FJR^h2-TWrKlc;m{(Y1@6Ty!rww;{r~DC4PjZG%TA?UaUI0{anpwy@GlQ zP3m;cU#Vk`rGgv|g&!Qu| z&b7^;=8{um{(C9)Vz(X=cae*Yi1nqQH@mofJ1wGmw2yqIVV1?B%bUT*;v5%8<~7(pDvVfgFHyM<*I4s=TQG*bE5^r-u5i&FSrtDJ_}zo&S0l(e4VPJPdITa z@3Um?|55|(VG$flDeW1q%=aTQuD3%qWQ|`{rq?AONwzmjnXcWhgxGc2yYqwuAIL^k ztz1{>WYp!sU1%JlH{Wp>aA`1Q_HGYt<8HQSi1SiycLoOrReSoY@s&$eq6Pxqd*pWV$ox#Y@6Zj_kx9$>{x&F?Lk|4HHv&;AYdgX3;{xm#pe@8z- zJUG{omQuV!mYS*+&s61=9+x`CC4xM;l2uW;%SZiU>scGYwlJQBf+w1|uYHfWm!_#6 zQ!zCBt-GB^^xPh~;lH_9T+4TUVpTOT>ds?XbZ01HjH#K73?LBW-%K0LXskbDBrXMu zeHh`l=1_fIlEiWK}N+N z;RBYyG`YKvOSUGPyp{xkK%2l9rS@xlT66&TNx1d;?hN)UJq5y(#aPM`{*SbDbVlt_ z*u{-QuT4+6I|qpt^5Z;ZP_ zZ3odTsJN_k!n7t9W+pdXN=2|p02+-|2nU?aCe41-T9cZ$EP%IapEm^%Kwogn#xVh! zzsAg;hZE}^w_gty4RHdDG6Mb7Y;&I462KuN-=nvfUo!rf3p4VAx`09A*wMUQLsS5b8+Sp5M|GRa)g|T}GDV6EpeF|pwzf8(Ep1n2d z8nF+WE52_-XiL&mU)b6Bxp6>fX|g{?2V@YX<5;}d6nylt;IzfkB($J=R!DI{OmK$| zF7T=H#e~U`t_1}ORdcUM3;sRIPihAI`@eJtL-6O;YA$(P2WAu)2eA_j_6S|=Y|qg%PAGTb~;ePZ>SGBapwXN_^HTp9=wg5kan>U!%vLW070KY z`!b4_zeNnAi9vHZ?0-2?Gt`3Mz+?S_1U_9GUt_0Mm`xDY7);xtPb_ysFyX}b4Fj!2 zk}hk3N@>$4+%*~E!-=kf8&BPZcf!R$=Ps%h=R*lTzuDnwgIxlR3^4zX7ah$T_`kny zVh)Q*Ft~IO3EuivFPR!Amjf3sR0Ut34g@<2rLk%E0xM?0$LYZdpe28Z$Y28*5)kO= zePkKL{Qp=?|33{bmLkc6OnKjWk28T=_sH@`vY1l!5+I5d{D zcP9wj$J3-xP#@uI`_Bx3o?qx^wHuX4qQhka0Y5wU z&%Ds#i6Glwr^cwO%j{PUT!0HoS3ggN_LzXP_A!=t9y@@QouK^{>^*e}P4D+qQ9wQt zXt=Z*@m2i4BzlM>F-`US>zbSYTD*5x)TKg@(zdFCA58I{MfyL@@BcPp`*%LmY&>85 SbBch$2g%DQOP5NT`27!@RM>L> literal 26315 zcmbUJbyOcu@GXiCPH+oOAZU=_5?q42y9N#JZov{fxVyW%2AAOO?jGFl@IAkC@B8De z_wG8t`oPRE*4@>$YwxNKmX{SnM!-h^003D+Tv!nRAbkMmoa$R(_2YHHe~ZT&TL102&I^tvpF_b0 zO5%@4>dHRl(+u{{Ko>e$Se@?IOCOHsEjxE=(Bi7^FBM#s-h;4P*iex^Rr%i>H!@IP?ucZ;$J6JB$>E$*6A}x)NHJ0zh|$09A1*0 z3$fBXVi#}8JJt(W{`u>)?s4hgWhc-9)7@o-7%aTGx7Y7Tzu59Tclk}$^o5m7UmmC6 zhu+im@lD{VTlSKVUSUyD778vnQhGyiej*dw9R=1=q=>R4Ye4JQ4x`YTgF|AfbAOnm zc~&ZVyTH%`E%N2rtQ%$F)XPZ44Z=4rE>7m`<5a#ZZ|vP(hR@4)LqqPzocD2@H`06f zcu`HNl$Ef{)&?7-4#IQp9?pfQET+i0?@BU^6j~ttf10=lZ6CiJkB2Ys!`P@8uhrJo zWVHWVvLJj-lxVAZmy8_dxWF`Lq2Yn>)}3@^&VH7upO?B2a5TPLYo1A;`5jKLp%QT^ zYiPU!W=BuY{-!M14Gce?YAk6uyl~f=-yA2&U4C##<1N$E+QVT5!~|>L*acG}7^C4a zf&DMEltQ~?6coni>wl#8vfJi;cx_ISN^Nux((N|Xuae7_E?FRaNxndR?c2FdmOo~> zJGwShBp&jKTcK-eG@UeE63j!w{oC=|wP$K7=Ae~KiE(ZyfXU*&XAK|23HF;u|1o3H zd2C$$h*Jd{rXKM^Ux;82yPYx8Xj|LZhzq2y@EpU*zPNQqS8n`ZDq!Kr7^Z~J{wagE zca`v}+tRaP8~<6W-uXn6K4JKZTOgUP4VEqxaYH2Z@WTaO7)MtQ+wt;n)Dw(ZB>VwOWrd-5`_|Fms*GfdOhW*F z7|!>XFt6-)zC9~fy-9VxxcBZk8|9kFEGf7UnzyVMt)QJhsTVC;dzZ#er<3rjCgUpj z__D^YoeS0+6n3=V;4uIGvsA7-N|#Fveh{{v6f^1mvQ*k2HNx^xw12c|`qpvvUdVW~Sr_d3vGV`0f>0w%@MQ&_?fp^VkIF2a0G!PL-v0+#)nf2ge ztN-ww?lAq!zhmB@RpiMo@dP4l?P2^LEFC;rpd@f5=-wPR5|a$y(qbj&r8T~m)wvjE zUzAFS1)}l5G1>c>vW(Bk<+`Y)%yqx^_~{=e^Fvl^b)U(_!YsuMDN?7^N9@p~QNO%} zgok;b7_+teSXAtn{y!7J2yOJbIt`W!|E6G=Y;p#?51OirlckaZUs8l06^UcW-JTz= zJ39q{%DTFhdaD%4Jklz&`H^o>wp+>h^kG=O1V;IS(~1>A>~5kgV;v>Fx{7a;}o_1CYD<_@628~z2GqfhN?cKk=A?E@dmEE#EOX-UZt1LmzG z9B2~BFVs-LI?O*otP#ZEn1fiag+XWq|AjKIXFp(){Mr=me&*Kh67rrzG653sWz``Q z)a%IH{kN>lMOo)69eEFTsy#|WQ=zImN|WrfKDx=oD}CN<-=s|%HI6zHs!JL*uw!4= zGTpGGg&;#@qI>3dfpw!drschTGyMC|gQoeglk_5v|6TcYip@xi)6s0b9t!Ubp}C=< zh!>9cJ-5eW$`50`u=XZb*Ez+(M!PL+23>6(oi^KzE@Gc2yYE@$(ij&2@^A%?D*vd3nfL*DsJw13HI?kG2P6Mmm1CR`2$7+>83~i<^ozA2aeHXeQG` zqEYz9l3Q5VgOgeq4rD$t>}T#I5=dXO59nntwVyU}>1c*<0HG}j=62^!XIzLY8OiS$ zcmd{vmKN6J`Q}4q9#F^w$2X+WWALqvl*&)10bOyWW`=9^*A*1Mz!!M?pb>+xZyqP0;hc2d8lB z3-+}k{5ZxOef!K7yETk&_**jLtpe?RlAT#n-|iiUE8Z!T4dT}c7sa>UiBeFAPS;Z@ zjZBAYc@floIVx3PVSX=hO#!}-q7MsQM<{NRI02X0Vo_UBB%EcNIS04(=+*bz_GBl= zv51fmgaqH;ZhEKn>5p5>O%7}Lt5&ll4AIb$Dhb#huq%@1rFb87o9vCpGX=p%tZZm_ zJ#9IQAmW}?zEWYpcY!;4mAT}2@c1fi$OAwL(2~Xdc-J5tivNNE0Ox5uX{g!zpNT~< zu2(v$8?PbP-ce?4Whc5jm%MzbTEc-L@xLD4v0Qqr19u{{u9(7cJznC+&JJ< z@?0iC4j)TlTi5r>t7@wIjp#Cd)z=5_omI0uX=v>driu{>Ik{JZu?=$Lvn~XfnF*N|fBp;(4xV+qdb6|ztFxY`EozAMg`EU2ikNl~>JzYdp-7J{!RFTx?k82qGn=r+j^otZJ$ zgxqN0haQ}(jL{`!HbbE3Bcq`W&p=21`vlYcV^1sC&>Zhr$oEibqfw)JBZ(ng-Q6`| zh|zqv4|H^S$Y@uxBN<8oz^z8=yb)_4L z20DJwuyV!O$QzIeBLs+F#OIg5!fn@>x%@_njW<=2c?^YwH9Q++1c4)Z*-*}5AS|* zyk@d%TP_F!XtPvc8TO1K$0HzUv0SJ=JUoPef<0bpU?3ssoIZoYi^;190^w(V_2Z&H zMM_6Qn_HnIB?Pd)esy>Z!*8vFZCFd=ILD)FcbzY~C5)nK=;O2A*gCxDJIPh%tU&UNpF4?>^M+ zY-V$~6&`#LUGt7@@aMoJB(Oh`)1P{a{X#;#e!7`h)#^+aLSLsl1mZ!{k>u7pq?y>i}5`6p^vK+9$ghFG+pKD<;OgM#YJJ0;eEv*efNcyq5N15l`3j7-2@s!=0a zq#QxWX+M_E3tEtc)D3G0C3Q(*O(-&~{_yN5BqP9z)buuGqTza_i~3)LOOoa!jzTl* zO@GRAHU?kI2~MPXird0E!!Ow!z~yzX&F!ZpZo6LmlX9=Bsw%6>NH%{d?Ecc#{cT|i zq3rhB-1Xn~U@E7>%iR_#%Fi16ouQc$H7$+0Yt3Q>)(pAhnLcRr$0`zlMUxgeoGS0f z$5u1lTw>J#Ejhx|sXK|+?xy^)cS48l%RbKCIC`;pX=>DQ0%#FqZH%)(2?=xMIxUpaiTcMbKj_|b=Vwp1iuC1XjdPfr z(h)-+9qk5ViLx`f<8QXmn7EhJ7YS<-@lR1s*4V>nm`^I%xQSlsz z)crY(z5T?%V;P>sH0o)mzthXBQ z$;hlPV?~pLsD;`2cwQ{>L)+bE=v;+f|9uf{EgzoE8En~|%Rkz9)3$n3RXCp4mvG4%=cy+did0s0UyEyk&TmVO0glLe{ zL+s_P&EQ%`-g{J*d^d~Zy!7unLnGZlSnb2LrffqJ6Jg|Hxe_>>!EV0QyY0V~;B1yN zo{80Ju)c8R0ruyswm|$Ceu;vAcb&03g$G0F`Y{)gOvhP$9PaOj>X>(=ztlC>USt?( za1VzOxBW?)C%Ag2@q?z^9>_&_(R1q;p&5Ro`Ypmx=N{m{tFIKYRXV5*dJO9gaxc6H zYu_WyZ5bLG3bfdAem>U|*&qW*Qh8RyMwY8d4>zAff>GG@bpE=jYZqiM29Hh)HCqeEJ3o?NiHV7-rLHtGI1^FQ zX!-Hl&-;vPh2+dkexqjoeCwH%s@CSDMJ9FD*Lt6Y3PgQBxl64S2VEn6(!^-erjHWe z|9L3F5GB5C-!!XpxRmIpQE+}qQPkff?r}T1#PL}Pi*NJ7m4L$<>E)@RjuzX;fx^dn z?BC~#JH^oJW}lb2N4T?buQsmTjm0{PQ0&jiY!<2-8Vj}Gr(`quWW@ATy-*VUvJ`&> z2T$N@bc%;5lvyL1LvCT?Ae-^+$(+utLhH;OmTb8T*6CEB2OCYLm5fm4wZ&I+DHH5hju+G1xo;c9Wq9bJz0#(C82?>f>S>)b75I}~-;P||Tqf0R zbl}wN9m`I6EoAS4ZozT6(GJizG`w7KS;Kq!Y*v|=T_p~pvC8syT&#RdLTHp&|sAm(!XL{8oVf0hpsp51g?`p?^7r;x9_&s(R5B%W2UWDDkB(Y!Ij z8~IWDiN#{9?G_JR33 z#e0ihg3EACysXvAwYyd7=?_WQtm@23$CuNa6Q&{FQE@6XKbA~|8(u@#*otH1I)3*W zx_de??TyA%uhYvW)PxkauU0dNu4(hMCIyqH*gxIb@nvKrC2>0Lk8f`qVG8S+DYJ5l z#BDw?W46+Ni)JdGv6|`;-w6U?c8mv`>OPc}OwD0`;fd9F?$UWFY|FI6satInKIIGz3 z#l~3SZj>5a?v6}12h^C3l@}H=E^7&z{1?_#7*DEuTg-;r7z5TEwO4{i^W7uv>WwEu zKPIdrAjpao7-whMH+WBE<*pjtkL4%sp_KJ(`dH7{Z>}eci;Gv?_K1LW+b=2XR*FT+ zLGCyM%Npi@^-l8zuCG?+LPX{f1HsK3tHP4}>kX`K^+y(zBi!8F5PMxsJU`wRAzTzJ z-NZ`R{1>0DgneJNs<@6Ozdv56VKVFkeEt2qZ91M!GC8u~SZI=+2mZqp3*lyB!|3(# zedJ5KHJiehmA0P=B%=A-*KhnAuiSq?0)%D1G`x=Y?zzrYPaTObFxZYHaz6yA?51VpPK2oVh&Z&CmmmJZ@_cPN` zA3~w*O`NaQ3C|z-rxstD!9H<)x!;?bntHrGa@iSr&n~P7{8pRE<@w#Er86oM>ZvH1OE51xvON}K@6`R%P+-b^C$?RvqVYJnO50fdK^tMUBabq_ngV z`$Kh^*>7sx9K!|ZE-a=2)=NS; z0eRiB)>IYN*G{5vEco)ct#Jvf!EQA@ulMNaS;{mVmh(vkL!o}Vv?BH?(_SR7z~`Yv?0Kmq-;C_n_2oPW^BC~U3w^MgnzHahghNyA#X zdR13tFoC?Hs$Dq3Pj2< zgi|qgL2M2V&7QqWExt)*BfBFQG$yv#XzQ&Q4`kF8&a-v~fUZll#w${PlKbNI8H>y={N&WdV(T;J; zZLjPj*Kil53;<;BIb21#&$wq0J!UGBgUAU>ZekejU%e}E< zO(YxUQs8VXefeT7gTz+65IZd1-`58TBn+>#xKu>xcCAO`?d&C}vZNsjM_a0+s#Aug z5>TQ+02##SSkS^0Nhde7X}wZ9lx=VzeTVBcF5zi>C@MOGQKC(r&pVh^UcmW?-psuPlw9O?@vh)nk? zCjGOxXfm40$Uu(YT z+e$kl$l_3pfhr&@KmxW4{OmevdBG7HWI&5wM4B#R#tX)&x+EzjF}PXITw2MQ1cB9>%2*cc0LRqm z@)xwpF*D(1Y{<%b{o=W!WF|5%O!<;DKCg#f9KGCjk{gtWi3~c~o;$YF+0+On!250*quY%fzFfBG!t0s8S?iD0Nz0Cl-<~4ScumnQruKmNrd>7ZRTX`!0fX1b-YI9(?&` zf7x$jYWf!T?(FPb?v3fSI9o00VSVhLbfGshFcOD?X3zv5B(3ZO0{erNYX>s8Ndj+p zXY!wTBwRY}s-#>QwmRwAhYu@mV5C%&FirHKju}#TVgmmn0cT(i+ZX~6O6d6~h$ia8 z2gbGJviWC6q|@dggLJmq20{wGJC}_UArUH1QT|DMQ5< zGHq68S36wIi}$GCcYP-(C)IS_C>R)QHhY5kpU%G$=tZD|D6U6tC}|Xine-XQ5RDB0 ztcsn#(b@V)PEd z)>{xpLevGDydzU_CpHcr?J6G#twSjWJs$T>R6e1JELyAQUVV-7A6C{|7lg47V_?3*ZOMfNX zm7kHR%q`pU50~KaK>aPIy#VX|dlCM<>9Uy1evnUI{{!WNQ)1PvEeDry?Y8mW0;MY8 zOqBTEW5|)wpp1jzMX5LDF+8Kg^Z%`PMf2N1_itm2A+P+A1FOP0Rr}p zUVZ}Pkn0V0q$tnm0UtQU;14KRSR8f&ygQ85l&K|vb&o~i2X2(x%E5H>r7eN0dy&_$ z1@>u>IQX($aM9G4u9D+s(|XYdfC&*ruH{3eT+BGeN7( zksgczAhF=&rC*J3GE-a=tfH6Hs5cUN;|C*c3a5cZCPMgZ^Hm6511(O{ z>3F{C_wV1FKD;e=jYG4m-WxxOi5g?;zgJ4xP?dN!gj6GzK)gXM{ij~{YsF;G-G#HY zDb$3|TJa#S1~MV{mwPPH!~s{v<=5gM`kWS>nVDI-OJB+}u8zhBZ0k1u9vJesM7E7B zZmp)Jo_aB39~RdimtN0e?H18UT5;V%_)bqxgUzU^p#d^k!)t393t=CJyXBG9v2n7U zn1A&h&ia|!!_xMkP*YP&ONBgm|Lg(b1$Rw-RnMk5k^GD>^4?xmd%J=AOq* zDGgpuFBFkeHfaZD-3!iNBrfP8xnAs5(M!zR4okV*6((?icsh-2#Uj3keX`5&_V5n2 z$eo$~7q204li%O>F=jvliEGqCoB^W(C;ZAu5*lprx~}e@sA`edYf;F>#mvCDOO-p9 z_kzfdoQ^8hc3Fz7%N3-SMVn?Cw~I9xMW=B&HGABamz3;;;f>N2iZ@0zSZd4Vv-l+* zL*0Z+W{X;~bqJ#^G#`)!MzsbU9F_p@x+<~5e+ve8dqsrbx|aR)syJQoj*l%W9t!f9 z2jSfZqP=#Xt$tO)--HVg=0t6x$(;-0?3VKY01^q+x%-Gf+sZNHgC_gz3>oX^%+ysy~o?Lmc~ZLG%BN{Ff6;jkD^XJvi41cdoza1Cv&ZlYZc4Xv@x;M zfN$IT3wOCkxk%j_O*Ze_ZH048Ws^LJ&L=3B(P?BGUEB51vsY_=L&L*bU{Hc< z@M2oj8y%fIn$|*xV1L-kV<+NcYGGjke6ihn2cSVP0G&w$6;KYt*mdX=WS=(H1%Y2- zVMbgGRx@{6Ir7om*4t_siu}gZu62 zXO!EfLr(L%n2x{pzH!zdXd3$K6`h*O0}hY;OFufiM_2bMK~mI-w9b~scg!s{Bl@4XiNzGAs3oEi0f)n@v zbg)Dj#87|w1OTY0sQE14gqdRK?)P9ODS)4SF-D$B+;2B5WH-)Q*pA{*a?6uZR(pjcsBzgy^6aBTljvKv$J@XXU~n9aW&B)|a2)H!z`l{q1e z-`pBP@jg5yg#h6BTmgm-L0NTXFR?sFCnj@CBcoUMf|R}xxF3VkQrGRSyn8QFhguOR z09$z1)hUyWIc`4;KDX-o0_))nZgqn>)Hmm6_}6jLWGgdBPa;q8tz8!a<3@=}838RC zhqO^hs!f62(B`OHyFlg(!JVqd_jtW^w@G&o|0tKXKX|w$$lrL!MRr(~&xa+@F!MEO zuT~j~fm3i-mk>8MlET0*Ty0d`kI#j26(Ovk1rQF<5Ig2v&QHOl*bK9TSZG^*0coHP zTP_7p+Uw``hzwagNT41O24DnP4>0J&-%ck58;pvoV10cZe$NKqrfo(IgBv~Z`qQl5m?$ORJx|>i>WUEZEdR4gCx2~w2M3ssL~0^! zduB4qMTe#l(q5lzP^Z-JW^p%SzE^Z8l#!xdxp$ND7d|P9$SP1wH3{@}H7kG$KHrpv zfYr=ueq2Fu84bo{2-co`$>^SH$WfmPy6SAs3a5?L9sT~mzq^Fl4!ct;P$nq=s(g5H z;q*Doo_0z}%_*s-r1gy5L~7ix4?%sqr@wzJgMTgk;BRf+FXF`sSYjOr_6N6YD&tVW4Q5d#e0AAek5!@t$C?={;NUv zhs?5`&EFcF%Cx>g3i(cB8?VOdWeL)xYq1MyDJ*J(1s}eLxs9jy-LW!2x3crMxOF*^3%-iMx!GP2$Ti~ zfyf3MI-SG#qp`5J)-kU ztc;;d#DS{fxb{xts?a*j=-mW}q2?#yq|2ZPqY9O-MCicC#-d%#&8|@{zm>91AnK`> zt10tAP{V6{XTC*xU!CnP&A3Jvz8b?59^maNc=o*GnI6F${0K~2uja`a$&oW2Wlv;_$s zWqeBux~Y{Vt3or!d+!)WzD!#t!Jzo0rG9A>wJ95CRkY|UK@Y*s*E)CdA*ej~cHwyt zRVkwM_0s7Tl^;uQUL0nnQ>6oJ%w6I}2iVM3&7=o;>!B2vDBYmOrC$-JX`FjyM=&8x z38C2Z+FuyBe;i2HDZ17DYgoE>fc0QWLpQ<-gVTT06GIN9NxHu|*Td0l#?y#@mk4hZ zwks&4%u)YXURhjPD9>HoT*Eu(aVNEv@xpfRLzUVfqsF^gl;k|Ie()1g6_np#0z$~>2X?a;sA6R*e3whI3#mlyhL z#u<&;GuuaRzbPD??O{=+TSN)Imcs^vFRR=}`N@YtuU@VF`ICHV6}m9K=wzani?xG$ zDM{*n;(GB*aAEQ__U|uShx@nVE>9+a#IRW0ae9af)+0*(1 zqHPr=yUxYJrCmeoQ0guJf%EI0tY?Smg)QBhf%M7+ar)oy+EaN--BRqs-@|_86W=&h zaS_!#EfqGs4%c;nc?XG1hN7o0T81&K=CFiJ`uC~j7#OQ^HyFuvtq zJxcsg`Q1yXW^#}9yS-r1oRsYm{mb(l_PJSG3s%H%C}@8^9(x)&QFQD}zSJ0W2YLM) zq!N70(c&Zin8P#|q;2VE!t!4taeg5(nB?)Zy4Xo6-j=8AX!imrCuVvdXeg z3>Kc1HEabo=V%%I4RKK2l)RkWH+$s&YV7V)&hF?C_pxJsW3up?PIaur^A~tW%7Z$V zfAg2`R*I^o7lI8**;TkQY+|9^UabwLrMoUGDK-fi8K{7+^D>9~V&HA@VWG$^;6j1SlEaH5}} zpn3@h20$ENdB%Y;Eh_sRNiAQ)Gt(+0GV+F4AU?Nf*9@>d)PMHY>z8>QsBa&?7jSCu zd40b1agpr6Ot|DNEpToqNj+ToA!R1h51mYtT)R9u_~X>1Z5-1)q-mC{3ihuM=<6jZ zH01N#6|>wm^E?%^XbKhMkPth3++QhFOcORO-Cwr*j!WUk(!F`5&NQxx`TN$E4i-1) zZqN0xb-w$owpmd@FU|7*G$LCT59aJu@vW|t>(|hb5C5qI=t0>&HhDtN zFY*vLTKVwEK{J$|SWQ;lvC{2i6 z@S4Hvp*k)eTBNZw@9yEY$l2ulId;C|OUd4d|1tiN1lqN+H-}>+Lm0Ppx zi-W?1nru@X(s-5YHG(&?6{bY>j}M1(6*rhp=WSPG*92o&pf`L;(LJ;r0lf_Ga<}um zD=NP!ZA6y8ostMys}kD&$#{+-+}Ad=Z>ZSN`tI~}AE!7CWbN##B=cx!Xh@7Bm{9gKDJ$qtuMJh=%L%h?*=CP=S2b6*@DqGk!atyj{J zT`wcw)h+EWsc#`v)p_8U=Xl(n);!KLq%yM49c?_{`#}+pN!K6JM2Wv4^pP@1z|=yv zGR4W3>gW$cGw+_cl}+A#n^|uL_=+(a@)IL7s%z7~HT0FfmcNw&Bxb&A2IZ0>OGcS! zZTgC$A_brP+FIqTLaU%`QsO!tFgsR5qbLf+i>pmAa56a=ze!s*Lq$hNM^!anu_z=o z^uVz2RqIw1zowzV#n#r=-rnBH$*Fkj`1lxX8t`*-Q|S2&{1DMTbo<)Y{AJm6Xnf5( z8Qu4!Z=jWxMK$zc&Be4YkHd9=g`GJ3ejRqh3DgcB80jI#u8-ClgxQ@J)Ie6HN{4?T z+0fTDOubh7Eg#BJsC-}QS|*soNL4Rx z!{i2ay8H%^OlJsi_hd01*YY|Ba|BF#zn|;W@1p%EpFL}TJl*UK^&wg~SfowY?7+Ed z@UP4G`Y3I1|8GY|Cr^URjDc+(%rt_AgHu`p^)FRb6gyFzH)#$rq2jj@Eu%|HHB4-hdf7^gVU!G%qG%;NLDBt9S6^dn&M!XgFI;P)T|QIvh=?d7KG%>J_TWe!hG1+rG-?8|vjdc<-$igt=9@?31fPeN~b z<()l)4oAyK4S!n=aufB_Pi6sV-zdU=OdS%)$P}B~h#=Y5BsHC(0%$mddqkeD^nV`* z#}BB*yhjM`4zFY0EvTr%fHMufHsBl38(LKJ1={gscBNp`u7lc!``Jr>-}C|ucNEK0 zHdlW*ka7|N0gR<0-pjLzoS&h0lLxCc@i@fC9T#YpX`I(hdNwOQI0ZRO zc$R+FU{%>$076AYmGAJQwlkZF-Ak*icZ1K%yOlnjSR2!U#&{#q^o7Ah`z5E*XTJ@! z>s86mmhLyIpaHwQcFNvQ#*S|7scIiz`Vept{t7;AyNNWlfFn2B8#yUct7nqs7_*16 zJt2%mzA(&_P-vIQ2!Kc&S?rGHHbDsOi*+peG-Z%D?--^1lI`wN4SJjGAaec(&W4aX z)1ANmI;MB4%R1|)9(t)SjeW(<#l=anI+kB{=vVwV6vnEi#69Nd)m%Ir*X`F{4H|uJ zlaZCEZddGRO@Gk8-#4*eZN?ml-GNai$bEXQ(EK{F+-c^dB*lJqvpfk13QzXp@Wr0c|*IQ%yjfp9S@foh>(!C^Wq9-3dIuPmcyYwa& zh&`dcQh*yB`-h2EUv*rJj7JYIZgZVRhLEzlQZ59h1%C(st>*s9TM`MA(Y zUw3~4nvfpok-7G_(znTJTA4P_)oi#9KjL~B8cf`kA^zUk+?Y4=Ct!a4?qW+CRDynr zbZeH;;)A&`ny(XZ+kcNGZx`L^P|PT0p#-KCg8S-~;ErVLQ+GJqp|~_6@wp9-ho?+# z>LagQ=5Iz^Ab*fJHy%-~9dm!_lSxiuD~N1MA;ST9_A20f$-c`0nHiB}fNvZdu#Kex z*;%=XMZ+RC^{)uIH)fG-tnjYP)t(qAwh#wgtDhZ!J2z1PAm1B+SYH|+1%7MDLjWB} zB|staWJ=e=n@-X?J{%``5~y2#T}7CAaRcUd0hwTC7cky2mfp8?uXQFbv18LVb*pXw z;(n!|m)Q_zb68k?BUg*rQUfkTac(;NS!T-#*7u1i!BgXmj20{ThW9(A*?mkNgLZhp zC+(K;vD@Q$2w;`-1_1J*-GI)b7h-wp*0G8*e@&0uT=r$6CP05@77qxa!2;G9ZCTU4 zn)j_HJZnR&@8&21xOQjcZE6ybz$b*mwTb63-7@L{7+*hT7+|~43m&L|af9qE3WEgZ zFU(DWM&}M_;O2V7uetN-K0p`H7yERe{?ZC(8>_-_WuNDbfQ!a1NERT^JrgpkTuc$K zThh{-h#XF{(2#6~tLLfhjF>4T0dxk{+?oJrf;kZSFF&qW0PxiJP=q7pcu=v)s2L>s~Y#xs%t zt}tJ&&EY@iT5waND$e3$a+|ZHi02(<&%4Jn;>wPhs3L zD6jj?G6O|&;&i|M(Gu*x&?b9sWsvy5@WpoT)+Zm&77hDSgdQZSCa3q>%yECG`1+Lo zKW7OI0;qJc@G`Rk)?n?IZ`8I@0>LF434X=?C&;-D4k`2R&3z^{l%YpD`?{D z<`e+8a626VSg@EaSo%3jIvVz^J~@u)trU45JmalaM=;h_5zHU^FIC9Po`vJ%TaB?v z1Ps(#V3cs8@0vboMEohF=-Y(}5g{4P{t6F*`SaifHmk_~E2KU_n(}%ptd?&H02zAF zuLH39;3a-R;QFG2&kd^&yq%2uM&E-6eeYrQ4agN36bBrg7pYeyv;HWkfBPHV8>kOa z`2z*!haRD7;b&^YSYJ0-eUNEHkH@B^kccLi_)e#X7UYviS)fOKeuR?S^D~*b6Lj;vymI zR%GO8SCAkNu4!dPMeIt&bB57jLF#0dz!&(f=g+UF*Fgd(G{+Y4)bXn$z-QfvC0h^B z6N3K{^bE)!?du?bL>F(^N9d&@^hsoIyLsU^_6tn(2|5hs0CV{N%9^!4Fh=*lE3l%% zjeMNOc-pKCrL(rKg(p?TFMsSrf~quFT30x#&B8+Bjey8h?TC%RiOw#=ZjSbMU(!hg{tI&;@W{?CL*I>|XrQwyaIA&g^ThVx;Ef5-tu3Ti+ zS}OV6g@j3$Kt|EyE+o5CVLXh{(n@1v16XjRqnSxRJ? z-l=iYjTC~)YX`KLePuX+K#wvZOgP%tb9V9oy7;%)uaI~5@}4xxy-w|jNb;@D9iLGM zo0e5K8JFM>902g~voldsOC+m5;@+X-dZB;An*AS(1@ZF#KRf{5}*ZH$;d3- z8L5LYfnv9)|yD#EF~n3+iJ4-R%GOl^m+z3C!P`S4bxJ_W@ECyQGA~|3DO_#s66&p!@l9 zF5-!O+2?}kd!&;D$}m0Byt|Xlp<%dxmD%FQT@S^;x76M5im^5;IgEmcHTn?x#Ee3} zu7f zf^;J_beA*?br1f&d+&GuxX-=(F+6jgGc)__SZlp&zwg>-3B1#x^W;3p2DRcE|IC4G z{a?BNY||x({~z0Q<$i`;gmX!O(b2eTo*jfW1!6>B8rw0QWmkp_D%1$PS%jDmtKP`! zDd)eB)77;#$2!|LkyGhxDAl?im_j?kJ;nO#vc1?kfZ3{}f2J~CyMi6|VAkDi@$r9e z$j!f}v%*s!P$oe$1U)pSuUy>!ETv)p{uzDr$iwdHoZ*37>k`(5mN(sAd!o~8!v5RZ zTyQ*|J#Qf3EV}$xvEzAd;s$y)4{ALZ4jEW2rO#)qGwJ1TrQVD1)vlF{c-c+* zmiao~5QzDzM(7HWu%$I4Wn8Uvpuy2IIN;j`NhH$f$;}n4un|@@o3sU)yWg5YEk)YV zpadSupUw}fm;m9*`0a@##?)M**N0xL?R^OLqC~>y5CjcSGaml8d)vBAMMVV^Yz(@* zi6I6@!9dS|py8`}euON}Py7;Py-5Iz>xzm~RKOVWV%yWCK%*U3V5c7{D;&4pR&% zCXfecqx>rqGg0}ch#_{P({e)-6Z-26Hg|f|nX05Egas|2;F$4x`Di1}#HHf6Uyp~D z=-X~ZUL{Kur99uZ%hRE5t;w8^0Yf7v2lTGcl1tTh>HB406>!p}i370}MzLp*erW-L(^1~E1m6V^x$qAibl{P3Ip z{YWzbI+Y_k%vgAN6Tzw}2bC7`M~$o%eHrRC9wfvHfV~#)(|@cq$Yi+u=h8AsY&&VrL^?H56I~&f?Q|*}@fQ@(Rd{!W(lH1`Hwzmn}>i4bZ;^IF&`PdOIvSkx}oys$h8q6N>Yqa%qIkoNxrdX z;M5I_XSw{{q+BNAyIEdimcRkoj3Pov(hI8GC@=?W>@caPO<%rf<1BS1AC|W14Fs4Y zCoNG7OhhJo`Ch1Z<`}Y+NpX&~$CnXdmXG)Gk+5n#wjT)3@x=a>wql~OIoR79_MdJ8 z?eXJKX3O)TV`jT4K8H#CJP{qdT~OIF4I#g8xZJww{MW>d=)h@Au=f8>ACTdTO-e}6yYg!Fn`;|ye z&wY2D`=gMkXgpaJrg2i8)%pma{ZCMDv438@VAeV)?%;#>BWhf{f|Y9OjS;59lIb<1 zMQbj0741Ko!lwB&j?buD@BR+Bb6vca!`Qmlb*7SDo++TWa^kKUaQK`FV01C>; z_CZQXJ5tB3VLCzwEEE&am*1AKKiYXf20-%#TK9La&eKv|z4SKhyJfh!*g zCHR?b{9e63$rcvy4u3mO+QnTZPApTAqF{z6eG;^#+Kx?6;?$HdtcvwO4{;g^urYwX zUQ_375-6Q`ML?T0j3LpN2C@>q`@f&zDY^GQwehylljo;+K1t<7p}S+7xoyvlQ@6XW zV1N1fM$WlH`vCUJ*b4w=s%TpWT*nurE3EZ1OAdXxFEDySK(_>RSc_)>?{jH(4vP1& zfWHov`M8vuYVE>#3`9V%`)P`crp%AfQHOb8!_i*-_IN2_|NHPfplAXTK-#^4bHyl z0+Cq}Nx)#f=f-(Y@!`y6Sk86+^uDSY1#j6>iGE{y-9k-;+^)i%Ohxt&_#0Y}1Yoaw ze(s8V@6_Eu`+;n=OWITrb$1~PWWXj7zknhhzm0Dnw@V@+G{?usj!wn4yzi+Hi`!Td z2b`Uq?{06&jzF3ciu|V`M#6{72Z2x)2Xso~>7$$?!k>^t))CW^=s@X6&SeG*9tHDk zbHGe__^HI()Ez$v?&m2g2vPMH56^!#Fg0RjMi|dD&i~chs@&P8Y^C#?sDH}xCRd?`N)oV#1i3mUKP*ouKgVBc?BOE{qyZpnM}IvaEPT!5SUtO z10fp#LOWYmVjqyvDeYi{<7_5dEv!MpOhz!E^LvIJZUp*!+o)aDyIK}*Fz*h6H87$# z_-*^Pt1sr<(kfbt<|!cRMz5~%RH8uoH4$=H2|EF?#HPfiEDenRw{k`u^v4V!~X9JJ;%E^mcMA4X4BtD(Np_th^^H}W{8U^`4cE*=FHdS&ON-9!_&MW@lc#6n9w8(xJKo%( zHMilR4MQqJ+=9&CpXlBx)ROja)|!O=7)xTJ@2?v2Bx%AM-8rKlG4_>|eYGU20`agx zbGq8gEI}-BBtUG&fD3tuv=%=RmH#8YC(kEMVU@MtDNZKylD{$74S- z8Y4Sn)V>fh49Vj?wRP3jjyHGKUidkC63#_CMVX0ag7~r8M9xsb*=!{*bQfc~_AgEd zH}=~V<@%-`ax|4Kb!zU+lStFIKo+w7{Xya96gaOdZe=;TO9FEO^>y%?bazz8H^O#w z0|3~5-H&bHWKwyGDSKy$%mx51*qWtCZi>I1j4kSf^LrQUjz?>GiBYK>bg_URIe7&u zdwXQXOqw%Y)?X*NUc}NP*sy>9PzFiCs&-y7tJae=86UFV;lajhc%$3&vk7CA;}y5U z#!h!4?3!gy%i~L23hK)f3s#G7!w`jpErCtb+E$AhG*GVua9j@3H?k^{oDC)+lrkZv z_xPY|H5|nHC3p}266V*I93sX?0FYaB+ew4YLU>%_eexNE9Vc6g=lE@qC7)y zA-%M;i6(B#9B)e6xBvh^8b{JFs7)zlIe_iM8~oJiJc&E(sRgkzmoKtpNj0Ei z;Vt*y-+YPLHuTL%8fc;^TlGAd<+&ft_xZ{4_vD+L zGD0AfwlvtlCzjnACXJ8T6qkkOR6eF%F@2Qa19NP2a^x)v*jB%4Pczjm{`QvhMz(Yj z1#ob+3nAXYw2h(c*o`GCku99I!j{JDb$o8lPF7=;9ua;vpt+y^=>}oo0&7+F7Ouu{ zg4IQPfB%}$6Lkf6oTq-M{7bk=)g&|dg((YkhL&ffse&9kjVSnbNX%W_2K-E{tkL1& z2D+FQpW;#qRt^ucDl-TP2b*YM*?9%Zl$(125e#n_UvZ|^&kt>4wdz%ju%#aO)P?Qr zwb)j^%U3C?`6D40`s~>Z4pgLJFRUagg-6?u+k~x27T* zqm#XeId-k}Q80b)VLwguDPTGG=kW}QB!GncV;3_dpNfUzhZX(a=bGa3Pe;VTzLkWC z2>YlASb$UAlvcrDaD#0e(vT3m9>7~clHj5Nsz2ffeSpWi% zWt|1KXnFL#V`@c_kuGL{Vyq=3>Ym=->T;ACK!H}%0pv^#~;;5D`uIVc$1xL_>DkK}_Ssa(TC1qtOQ6%^)7| z6&3JhHqCUX`*Ds^uB28r$9kXDwQiyQaGTHa)i)Hb{n54%^Y%_{8Oup9DD4Ps-#bmY zL^0p3F8gH{UJWx5os7P&e%6;Sg#9-U9_v-u1Yt)l>z2uB>6TUdUVkRhM3>xGXQ{QJ ztU~@rNoaNJ#6z~ZKKn+VldH%yueJ5r{2YS6+FR!CPb^Ww&nOx7&UGf+^Fv^~fv!?o zYHBm1xvBeJe5352DzPFshvjPH{2I;ONl-~i$qB?Ed-{G6;Tek0#UMnUvyiiGB;Oum zvbuKa1oO~Dys@%kf#a*_`<9%RCOwZjxK3xU^>nz>l+Jqi_TBmlgpd+n9x{+K0^PvP z*p`8Giod4e82(I8b9lBRD|v%nIQ}yj#@tFH^2!HVxKV`brwEa(BTg)1#Z%O-Ys;!V zZ2S4cqge4`;1y4dk(+me`vwnxA?wrDnvKbf4P1PM~AodF}=#6+&zYz3A^hG72N9U;SD5MgN=g;YY6#m{|u9C z=127j?4pJD6!#P|@Fn#f&}|{TW`%C(yE%_oJoX&BYyVz52mD z>X7zQ6mwTpmoC9Pn1~?uuX}*QE%@~KV+H(AAd?61>v1H_uGn~ETFDYS{4qh!srA8~ z+UPUd-;E;tJSu!@VbwY>*bBW|xfdq}L!+*jJaf$>cUkYQo)FMom2P4>zC z6>B#9eJc5_y`B3$sfq3VMPQJ*eQ4%lxF-Dm*3=xzAfGW=k96vww;1;Li=UmE2BoZ#L7dHK@&!&|dI#9oC~H|BiT|IBU5n#^HE*?gu7>%USj7)!Xv~H6zca;+XK_ zJ+i*!rBv8mK-%3&O!LR0KkS!2PBwWz2kEG=B6%P5SA4P0U1wN9bRE$0+kiCAd7Cs{ z-=AKQ_GIz1^zo^#Rf1qUyOm=X3Jv4ZxU}Zrz45bw5Kbx~Z|B=(beeawwgaxeU8`W%60BqU7f4JR>5%thoDqlJfp{*ESatMOY7t|dW;L@Ce|yXM=k z`z(VtMP^K-HHjo|F3&Pqa_*HLO*2>CcXHG1K1;h5t*#RK-%D-rP?cYH2`mFYg#!4E zn%a&2fFcjx)EnTM_s7#hOej^&g@?rl|u`ycn6;OIycHDh~BKGVQTuPwF~=G zDPL_fRE+@kWi9P7PvOf%XbUmGrZgDT|1 z4=G+Bdn~nDi`6BeJ;rC5T}}AQx}O)6N8D#wUw#0WlTo{mt@2MOq%(U3a<)fnc#|fo zyDeYwr>2pOUyC6OmdNJyj&Gxl>G^w2b%|jc;;+6ZO&Zrlu7y_V8w$?&+sL!FQo;h0 z$!>SHHAAckHbg9^HcHe|ZPr<~gGeMVMqTL?1*Tc;ohVvm!j@>T`Zv7zT}x2)A&uSs%K6eo~3VlFuou*UDY) z|HrzW1m1NePI0e*=pu~F7C^Np<{{S@1-t0DTCErf-v|-q3O6-m^U;KV?pnVL>4@@L z-yuEbwU|ZgnmvRyNFS!}K<7Dre)j$95TV$B;_R!yT|1fFmf~l!-%*JzW7mGZIJ=P3 zXj)S6yjerU`&9JdtD4KXovqG8C1W@IIiEAMSu4T-m0uDFx&$LJ1La&H@Sl84!Yl;| zi9M{!4t>v;N%hsQYlDNyF82k238V~N$S)R&#&Vf8lG3&Qv(!C(mxK`$+gW{LnzK3r zR`ZW(Eq|qs3E5Mj_Ui7qIH1K)t+VQHy4zZUAMTI$9_gQKkMac07E%wLs%mPp-m+6a zg>fUi#X(>$mB4TRdCSxuHu7{f4#t&nQKr48Q9qL`!j$0e-eMllG+|$=rAe7M-JS-GpDXve3-Z`o3vg_Al`Q8k^xCk@L`oa1Bk zDqEMsGVSix1{Lf#jyFzr!yZzM^>;f>4O*-b@os=Rl1V|c`RjeY-jA=-6{Y$NfQNBu z1G#`kegwwn5z9|6!uOoq`v1${(exbG^g7 zzP8~d{Xuh3p*xDJm6hY*Dwq@^myy*V!pcHd5tyK8;1D)e{hBlpbQA1%)!oBAF$E!{ zBJ#^`@v@O;rTOtq4Nuvoz4E?Q!p4+Hi5|zp6}O(Vp1FQK>OEaf*Z5}^{=~rWU|VrP zwv;aegQM*GNF-m;9)U}p0D#W3FadHg~>A(|N9CK@LoVt#XY&gaZ{T&XBs>R!gnHon{E+Y_@6u>PC#A zJDy12v)|96eRFp`9q3sg*Z65GNVT|7TF~wE4NFBbKDlRUL)vo+3pH`eHH(W6sfwGr zZF>TN2V{e*8|x2DO`0x4)x%Zoyx1-Q&o2TuBek{;VqNHVyjAKv=GQ?uNeWvhHSZvG zK-JGQBNn6CuNvTH}{&z=oY8*+JH^Gf}`K~y4n~XOevDg8fiA) z{~Gqk*G4nJcOoq~PJ3#Fy3=q5nnA^Dv6dZ|NXP7<0tF8Z(2)ht2*63}?raLz8L1;f`K%X!ud?H{^2eyoM@rHoSroZ^U!2ak8_ZOz_}ja@ihzJyOw_>wh)N z)QnMmQlZCK(b)W}YW(%h{?J!e8<~f{oOKmA0>5Px4)cemn*^^mu!SNL<0H0BWE6tP^x3xE86mdY;-$pMwB-8`0^B0aV<4+=SWE`jiR0vJumJ_vnyi8!#OvQaQmZ z3~|p9lODtK-Jw}ZyN;D+Z!U?gY}dzM1KTG?8w3!)xi|CXfk$4$0bqG1X$hC)nLh&X z0LQPu`DfbsjL(kZ7kV zLs4Upo?w6Cjbi50>VL+voQW_l%+%tF-DQ2_vYISkH#=A_EnXs z2Z%FWkv>MpT%>NWQghvJ9igFrnPijS_+PvyF4^scj>&Q4Ol$nk{b053>!2;dCfU@X#b@rAmfM1(Z*{EgSf2rXLLSx;Q zu9l97tAzj{Mhh>cCOUvOwBBF_L>)H}fzgs9SrGBsBrv}Gg_b^zeG!rp`3lyAe-ws* zvX|JGWJpNqF`|q#VXOGk19ee}U?6Vw(u)oOev7Mw?6Ij2+4j?19IR5!T zGFhaq5W1L3Fm}fl5E0HWvdKf-{hy3eX)!^Tz#PVIY>L?u7I4r(9`^6q-`ZcCtn-Uv zEfdqtJ824*Dio{-+PfAL?O#uuaW(*16dr4pousv}qgxCQf0OC>0Yq2t(1KYfP&qQK z-I(<;<(;-7c|^_%NgJa^Tie%PmER9%HENYipNG9 z)saUp8%LhY*{g-&d93v*LCZF3MT1p^M(SrJ!3hE!opysO3;^zN|NBgNOlkp0=my{` zDqaWp`v00*|DPYoG6AtNnEQ|}UqnO5f);sXnCqeef3Y7;geAxRETf}B#!94?Yq6UB zCTD!oBo;7=g!-O&ILVG?oYg&#)qIl2&3jEHVJ|{{XB*rH4+2o%GrX}5`^H5or?s<6 zH#AP5>25;(34uf$Kw|hRyfn9Y`e?JP+ghQ;NPxosS|ALXnJ(g3uSw|-8_DxNjrAio6GvhT1lQYVQ}*vJbcq$*WM8Is=MHQgL-4_zADI0h zWMZ7K8y>X|4}Y8cn+?=D%nwCX$mYtx5!pg0|MlTE!vAG4{`Vfcr&5)xtsvf?x(2%% Nkd;z|luH-{{ttC~y9EFM diff --git a/src/c/dynamics.h b/src/c/dynamics.h index 570be16e..fbfeb672 100644 --- a/src/c/dynamics.h +++ b/src/c/dynamics.h @@ -65,6 +65,7 @@ typedef struct { int cycle_count; int transient_cycles; int points_per_cycle; + bool frequency_in_hz; } c_frequency_sweep_controls; typedef struct { diff --git a/src/c/dynamics_c_api.f90 b/src/c/dynamics_c_api.f90 index 69bc7ded..c4fbdb70 100644 --- a/src/c/dynamics_c_api.f90 +++ b/src/c/dynamics_c_api.f90 @@ -112,6 +112,7 @@ subroutine c_ss_excitation(n, t, u) bind(C, name = "c_ss_excitation") integer(c_int) :: cycle_count integer(c_int) :: transient_cycles integer(c_int) :: points_per_cycle + logical(c_bool) :: frequency_in_hz end type type, bind(C) :: c_iteration_controls @@ -1243,7 +1244,8 @@ subroutine c_frf_sweep(n, nfreq, fcn, freq, iv, solver, rsp, ldr, opts) & frsp = frequency_sweep(odefcn, freq, iv, solver = integrator_obj, & args = arg, ncycles = opts%cycle_count, & - ntransient = opts%transient_cycles, points = opts%points_per_cycle) + ntransient = opts%transient_cycles, points = opts%points_per_cycle, & + inHz = logical(opts%frequency_in_hz)) rsp(1:nfreq,1:n) = frsp%responses end subroutine @@ -1264,9 +1266,10 @@ subroutine cfrf_sweep_fcn(freq, t, x, dxdt, args) subroutine c_set_frequency_sweep_defaults(x) & bind(C, name = "c_set_frequency_sweep_defaults") type(c_frequency_sweep_controls), intent(inout) :: x - x%cycle_count = 20 - x%transient_cycles = 200 + x%cycle_count = 5 + x%transient_cycles = 30 x%points_per_cycle = 1000 + x%frequency_in_hz = .false. end subroutine ! ------------------------------------------------------------------------------ diff --git a/src/dynamics_frequency_response.f90 b/src/dynamics_frequency_response.f90 index 4018a177..81f96e13 100644 --- a/src/dynamics_frequency_response.f90 +++ b/src/dynamics_frequency_response.f90 @@ -581,11 +581,19 @@ subroutine normalize_mode_shapes(x) ! HARMONIC_ODE_CONTAINER ROUTINES ! ------------------------------------------------------------------------------ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & - points, args, err) result(rst) + points, inHz, args, err) result(rst) !! Computes the frequency response of each equation of a system of - !! harmonically excited ODE's by sweeping through frequency. - use spectrum, only : next_power_of_two - use fftpack, only : zffti + !! harmonically excited ODE's by sweeping through frequency. + !! + !! The amplitude and phase are determined by means of a harmonic + !! projection method. + !! + !! $$ a = \frac{2}{T} \int y(t) \cos{\left(\omega t \right)} \, dt $$ + !! $$ b = \frac{2}{T} \int y(t) \sin{\left(\omega t \right)} \, dt $$ + !! + !! The amplitude and phase can then be computed as follows. + !! $$ Y = \sqrt{a^{2} + b^{2}} $$ + !! $$ \phi = \tan^{-1}{\left( \frac{a}{b} \right)} $$ use diffeq, only : runge_kutta_45 use dynamics_error_handling procedure(harmonic_ode), pointer, intent(in) :: fcn @@ -594,10 +602,9 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & !! An M-element array containing the frequency points at which the !! solution should be computed. Notice, whatever units are utilized !! for this array are also the units of the excitation_frequency - !! property in @p sys. It is recommended that the units be set to - !! Hz. Additionally, this array cannot contain any zero-valued - !! elements as the ODE solution time for each frequency is - !! determined by the period of oscillation and number of cycles. + !! property in @p sys. Additionally, this array cannot contain any + !! zero-valued elements as the ODE solution time for each frequency + !! is determined by the period of oscillation and number of cycles. real(real64), intent(in), dimension(:) :: iv !! An N-element array containing the initial conditions for each of !! the N ODEs. @@ -608,18 +615,18 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & integer(int32), intent(in), optional :: ncycles !! An optional parameter controlling the number of cycles to !! analyze when determining the amplitude and phase of the response. - !! The default is 20. + !! The default is 5. integer(int32), intent(in), optional :: ntransient !! An optional parameter controlling how many of the initial - !! "transient" cycles to ignore. The default is 200. + !! "transient" cycles to ignore. The default is 30. integer(int32), intent(in), optional :: points !! An optional parameter controlling how many evenly spaced !! solution points should be considered per cycle. The default is - !! 1000. Notice, there must be at least 2 points per cycle for the - !! analysis to be effective. The algorithm utilizes a discrete - !! Fourier transform to determine the phase and amplitude, and in - !! order to satisfy Nyquist conditions, the value must be at least - !! 2. + !! 1000. + logical, intent(in), optional :: inHz + !! Set to true if the units of the frequency vector are in Hz. If + !! false, the units are assumed as rad/s. The default is false such + !! that the frequency units are assumed to be rad/s. class(*), intent(inout), optional :: args !! An optional argument allowing for passing of data in/out of the !! fcn subroutine. @@ -642,14 +649,15 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & ! Parameters real(real64), parameter :: zerotol = sqrt(epsilon(0.0d0)) + real(real64), parameter :: pi = 2.0d0 * acos(0.0d0) ! Local Variables + logical :: hz integer(int32) :: i, j, nfreq, neqn, nc, nt, ntotal, npts, ppc, flag, & - nfft, i1, ncpts, lsave - real(real64) :: dt, tare, phase, amp - real(real64), allocatable, dimension(:) :: ic, t, wsave + i1, ncpts + real(real64) :: dt, tare, phase, amp, omega, f + real(real64), allocatable, dimension(:) :: ic, t real(real64), allocatable, dimension(:,:) :: sol - complex(real64), allocatable, dimension(:) :: xpts type(ode_container) :: sys class(ode_integrator), pointer :: integrator type(runge_kutta_45), target :: default_integrator @@ -666,26 +674,29 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & if (present(ncycles)) then nc = ncycles else - nc = 20 + nc = 5 end if if (present(ntransient)) then nt = ntransient else - nt = 200 + nt = 30 end if if (present(points)) then ppc = points else ppc = 1000 end if + if (present(inHz)) then + hz = inHz + else + hz = .false. + end if nfreq = size(freq) neqn = size(iv) ntotal = nt + nc npts = ntotal * ppc ncpts = nc * ppc i1 = npts - ncpts + 1 - nfft = 2**next_power_of_two(ppc * nc) - lsave = 4 * nfft + 15 sys%fcn => sweep_eom ! Set up the optional argument container @@ -716,17 +727,19 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & stat = flag) if (flag == 0) allocate(ic(neqn), stat = flag, source = iv) if (flag == 0) allocate(t(npts), stat = flag) - if (flag == 0) allocate(xpts(nfft), stat = flag, source = (0.0d0, 0.0d0)) - if (flag == 0) allocate(wsave(lsave), stat = flag) if (flag /= 0) go to 10 - ! Set up the FFT calculations for the get_magnitude_phase routine - call zffti(nfft, wsave) - ! Cycle over each frequency point do i = 1, nfreq ! Define the time vector - dt = (1.0d0 / freq(i)) / (ppc - 1.0d0) + if (hz) then + f = freq(i) + omega = 2.0d0 * pi * f + else + omega = freq(i) + f = omega / (2.0d0 * pi) + end if + dt = (1.0d0 / f) / (ppc - 1.0d0) t = (/ (dt * j, j = 0, npts - 1) /) ! Set the frequency @@ -743,7 +756,8 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & ! Determine the magnitude and phase for each equation do j = 1, neqn rst%responses(i,j) = & - get_magnitude_phase(sol(i1:npts,j+1), xpts, wsave) + harmonic_projection(omega, sol(i1:npts,1), & + sol(i1:npts,j+1)) end do ! Clear the solution buffer for the next time around @@ -788,7 +802,7 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & return end function - ! ---------- +! ---------- subroutine sweep_eom(x, y, dydx, args) real(real64), intent(in) :: x real(real64), intent(in), dimension(:) :: y @@ -805,48 +819,39 @@ subroutine sweep_eom(x, y, dydx, args) end select end subroutine - ! ---------- - function get_magnitude_phase(x, xzeros, wsave) result(rst) - !! Returns the magnitude and phase of a signal. - use fftpack, only : zfftf - use spectrum, only : compute_transform_length - ! Arguments - real(real64), intent(in), dimension(:) :: x - !! The array containing the signal. - complex(real64), intent(out), dimension(:) :: xzeros - !! A workspace array for the FFT operation. - real(real64), intent(in), dimension(:) :: wsave - !! A workspace array for the FFT operation +! ---------- + pure function harmonic_projection(omega, t, y) result(rst) + real(real64), intent(in) :: omega + real(real64), intent(in), dimension(:) :: t + real(real64), intent(in), dimension(size(t)) :: y complex(real64) :: rst - !! The complex-valued result defining both magnitude and phase. - - ! Parameters - complex(real64), parameter :: czero = (0.0d0, 0.0d0) ! Local Variables - integer(int32) :: i, ind, m, n, nx + integer(int32) :: i, n + real(real64) :: a, b, r, phi ! Initialization - nx = size(x) - n = size(xzeros) - m = compute_transform_length(n) - - ! Zero pad the data - xzeros(:nx) = cmplx(x, 0.0d0, real64) - xzeros(nx+1:) = czero - - ! Compute the FFT to estimate the phase - call zfftf(n, xzeros, wsave) - ind = maxloc(abs(xzeros(2:m)), 1) + 1 ! start at 2 to avoid any DC issues - rst = 2.0d0 * xzeros(ind) / nx + n = size(t) + a = 0.0d0 + b = 0.0d0 + + ! Process + do i = 1, n + a = a + y(i) * cos(omega * t(i)) + b = b + y(i) * sin(omega * t(i)) + end do + a = 2.0d0 * a / n + b = 2.0d0 * b / n + r = sqrt(a**2 + b**2) + phi = atan2(a, b) + rst = cmplx(r * cos(phi), r * sin(phi)) end function ! ------------------------------------------------------------------------------ function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, & - ntransient, points, args, err) result(rst) + ntransient, points, inHz, args, err) result(rst) !! Computes the frequency response of each equation of a system of !! harmonically excited ODE's by sweeping through frequency. - use spectrum, only : next_power_of_two use diffeq, only : runge_kutta_45 use dynamics_error_handling procedure(harmonic_ode), pointer, intent(in) :: fcn @@ -855,11 +860,9 @@ function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, & !! The number of frequency values to analyze. This value must be !! at least 2. real(real64), intent(in) :: freq1 - !! The starting frequency. It is recommended that the units be set - !! to Hz. + !! The starting frequency. real(real64), intent(in) :: freq2 - !! The ending frequency. It is recommended that the units be set to - !! Hz. + !! The ending frequency. real(real64), intent(in), dimension(:) :: iv !! An N-element array containing the initial conditions for each of !! the N ODEs. @@ -870,18 +873,18 @@ function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, & integer(int32), intent(in), optional :: ncycles !! An optional parameter controlling the number of cycles to !! analyze when determining the amplitude and phase of the response. - !! The default is 20. + !! The default is 5. integer(int32), intent(in), optional :: ntransient !! An optional parameter controlling how many of the initial - !! "transient" cycles to ignore. The default is 200. + !! "transient" cycles to ignore. The default is 30. integer(int32), intent(in), optional :: points !! An optional parameter controlling how many evenly spaced !! solution points should be considered per cycle. The default is - !! 1000. Notice, there must be at least 2 points per cycle for the - !! analysis to be effective. The algorithm utilizes a discrete - !! Fourier transform to determine the phase and amplitude, and in - !! order to satisfy Nyquist conditions, the value must be at least - !! 2. + !! 1000. + logical, intent(in), optional :: inHz + !! Set to true if the units of the frequency units are in Hz. If + !! false, the units are assumed as rad/s. The default is false such + !! that the frequency units are assumed to be rad/s. class(*), intent(inout), optional :: args !! An optional argument allowing for passing of data in/out of the !! fcn subroutine. @@ -940,7 +943,7 @@ function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, & end if freq = (/ (df * i + freq1, i = 0, nfreq - 1) /) rst = frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & - points, args = args, err = err) + points, inHz = inHz, args = args, err = err) end function ! ****************************************************************************** diff --git a/test/c/dynamics_frf_tests.c b/test/c/dynamics_frf_tests.c index 3f8b63f0..da689199 100644 --- a/test/c/dynamics_frf_tests.c +++ b/test/c/dynamics_frf_tests.c @@ -193,7 +193,7 @@ void c_example_2nd_order_sweep(int n, double freq, double t, const double *x, const double wn = 2.0 * pi * 50.0; double f; - f = sin(2.0 * pi * freq * t); + f = 1.0e3 * sin(2.0 * pi * freq * t); dxdt[0] = x[1]; dxdt[1] = f - (2.0 * z * wn * x[1] + wn * wn * x[0]); } @@ -204,7 +204,7 @@ bool c_test_frf_sweep() bool rst; const double fmax = 60.0; const double fmin = 40.0; - const double tol = 0.05; + const double tol = 0.01; const int npts = 10; const double pi = 2.0 * acos(0.0); const double z = 1.0e-1; @@ -218,6 +218,7 @@ bool c_test_frf_sweep() // Initialization rst = true; c_set_frequency_sweep_defaults(&opts); + opts.frequency_in_hz = true; init_vals[0] = 0.0; init_vals[1] = 0.0; df = (fmax - fmin) / (npts - 1.0); @@ -232,7 +233,7 @@ bool c_test_frf_sweep() for (i = 0; i < npts; ++i) { s = I * omega[i]; - tf1 = 1.0 / (s * s + 2.0 * z * wn * s + wn * wn); + tf1 = 1.0e3 / (s * s + 2.0 * z * wn * s + wn * wn); tf2 = tf1 * s; magans1[i] = cabs(tf1); magans2[i] = cabs(tf2); diff --git a/test/dynamics_frf_tests.f90 b/test/dynamics_frf_tests.f90 index d8f4fca7..e8a22936 100644 --- a/test/dynamics_frf_tests.f90 +++ b/test/dynamics_frf_tests.f90 @@ -54,7 +54,7 @@ pure subroutine example_2nd_order_sweep(freq, x, y, dydx, args) real(real64) :: f ! Process - f = sin(2.0d0 * pi * freq * x) + f = 1.0d3 * sin(2.0d0 * pi * freq * x) dydx(1) = y(2) dydx(2) = f - (2.0d0 * z * wn * y(2) + wn**2 * y(1)) end subroutine @@ -66,7 +66,7 @@ function test_frf_sweep() result(rst) ! Parameters real(real64), parameter :: fmax = 6.0d1 real(real64), parameter :: fmin = 4.0d1 - real(real64), parameter :: tol = 0.05d0 + real(real64), parameter :: tol = 1.0d-2 integer(int32), parameter :: npts = 10 real(real64), parameter :: pi = 2.0d0 * acos(0.0d0) real(real64), parameter :: z = 1.0d-1 @@ -90,13 +90,13 @@ function test_frf_sweep() result(rst) omega = 2.0d0 * pi * freq ! Compute the FRF's - sol = frequency_sweep(fcn, freq, [0.0d0, 0.0d0]) + sol = frequency_sweep(fcn, freq, [0.0d0, 0.0d0], inHz = .true.) mag1 = abs(sol%responses(:,1)) mag2 = abs(sol%responses(:,2)) ! Compute the solution s = j * omega - tf1 = 1.0d0 / (s**2 + 2.0d0 * z * wn * s + wn**2) + tf1 = 1.0d3 / (s**2 + 2.0d0 * z * wn * s + wn**2) tf2 = s * tf1 magans1 = abs(tf1) magans2 = abs(tf2) From 264aba29be64ca83ea1a96c03e6f50a3ce00f74c Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 27 May 2026 14:03:22 -0500 Subject: [PATCH 2/4] Clean up comments --- src/dynamics_frequency_response.f90 | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/src/dynamics_frequency_response.f90 b/src/dynamics_frequency_response.f90 index 81f96e13..261e7860 100644 --- a/src/dynamics_frequency_response.f90 +++ b/src/dynamics_frequency_response.f90 @@ -588,12 +588,12 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & !! The amplitude and phase are determined by means of a harmonic !! projection method. !! - !! $$ a = \frac{2}{T} \int y(t) \cos{\left(\omega t \right)} \, dt $$ - !! $$ b = \frac{2}{T} \int y(t) \sin{\left(\omega t \right)} \, dt $$ - !! - !! The amplitude and phase can then be computed as follows. !! $$ Y = \sqrt{a^{2} + b^{2}} $$ !! $$ \phi = \tan^{-1}{\left( \frac{a}{b} \right)} $$ + !! + !! where + !! $$ a = \frac{2}{T} \int y(t) \cos{\left(\omega t \right)} \, dt $$ + !! $$ b = \frac{2}{T} \int y(t) \sin{\left(\omega t \right)} \, dt $$ use diffeq, only : runge_kutta_45 use dynamics_error_handling procedure(harmonic_ode), pointer, intent(in) :: fcn @@ -602,7 +602,7 @@ function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, & !! An M-element array containing the frequency points at which the !! solution should be computed. Notice, whatever units are utilized !! for this array are also the units of the excitation_frequency - !! property in @p sys. Additionally, this array cannot contain any + !! property in sys. Additionally, this array cannot contain any !! zero-valued elements as the ODE solution time for each frequency !! is determined by the period of oscillation and number of cycles. real(real64), intent(in), dimension(:) :: iv @@ -821,9 +821,14 @@ subroutine sweep_eom(x, y, dydx, args) ! ---------- pure function harmonic_projection(omega, t, y) result(rst) + !! Utilizes a harmonic projection method to determine the amplitude and + !! phase of the supplied solution. real(real64), intent(in) :: omega + !! The excitation frequency, in rad/s. real(real64), intent(in), dimension(:) :: t + !! The solution time points. real(real64), intent(in), dimension(size(t)) :: y + !! The solution vector. complex(real64) :: rst ! Local Variables @@ -852,6 +857,16 @@ function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, & ntransient, points, inHz, args, err) result(rst) !! Computes the frequency response of each equation of a system of !! harmonically excited ODE's by sweeping through frequency. + !! + !! The amplitude and phase are determined by means of a harmonic + !! projection method. + !! + !! $$ Y = \sqrt{a^{2} + b^{2}} $$ + !! $$ \phi = \tan^{-1}{\left( \frac{a}{b} \right)} $$ + !! + !! where + !! $$ a = \frac{2}{T} \int y(t) \cos{\left(\omega t \right)} \, dt $$ + !! $$ b = \frac{2}{T} \int y(t) \sin{\left(\omega t \right)} \, dt $$ use diffeq, only : runge_kutta_45 use dynamics_error_handling procedure(harmonic_ode), pointer, intent(in) :: fcn From 9d65619148347beaddb88b018fd7451460c1f780 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 27 May 2026 14:03:29 -0500 Subject: [PATCH 3/4] Update documentation --- doc/index.html | 2 +- doc/interface/frequency_response.html | 2 +- doc/interface/ode_excite.html | 4 ++-- doc/lists/modules.html | 2 +- doc/lists/procedures.html | 2 +- doc/lists/types.html | 2 +- doc/module/dynamics.html | 16 ++++++++-------- doc/proc/chirp.html | 2 +- doc/search.html | 2 +- doc/sourcefile/dynamics.f90.html | 2 +- doc/tipuesearch/tipuesearch_content.js | 2 +- 11 files changed, 19 insertions(+), 19 deletions(-) diff --git a/doc/index.html b/doc/index.html index 64c7d2f9..13b7b5a8 100644 --- a/doc/index.html +++ b/doc/index.html @@ -164,7 +164,7 @@

Derived Types

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/interface/frequency_response.html b/doc/interface/frequency_response.html index 4926e6e3..b8d14d60 100644 --- a/doc/interface/frequency_response.html +++ b/doc/interface/frequency_response.html @@ -957,7 +957,7 @@

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/interface/ode_excite.html b/doc/interface/ode_excite.html index 6f0003eb..75ace96d 100644 --- a/doc/interface/ode_excite.html +++ b/doc/interface/ode_excite.html @@ -188,7 +188,7 @@

Arguments

-

Return Value real(kind=real64)

+

Return Value real(kind=real64)

The result.

Description

Defines the interface for a ODE excitation function.

@@ -209,7 +209,7 @@

Description

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/lists/modules.html b/doc/lists/modules.html index 5f523c35..82d70caa 100644 --- a/doc/lists/modules.html +++ b/doc/lists/modules.html @@ -122,7 +122,7 @@

Modules

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/lists/procedures.html b/doc/lists/procedures.html index d7189a9c..db37296a 100644 --- a/doc/lists/procedures.html +++ b/doc/lists/procedures.html @@ -278,7 +278,7 @@

Procedures

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/lists/types.html b/doc/lists/types.html index ff69cc80..77f669ed 100644 --- a/doc/lists/types.html +++ b/doc/lists/types.html @@ -138,7 +138,7 @@

Derived Types

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/module/dynamics.html b/doc/module/dynamics.html index 39f0b9ee..1e993fc3 100644 --- a/doc/module/dynamics.html +++ b/doc/module/dynamics.html @@ -158,18 +158,18 @@

Uses

@@ -230,7 +230,7 @@

Contents

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/proc/chirp.html b/doc/proc/chirp.html index c62adeea..01d6abc9 100644 --- a/doc/proc/chirp.html +++ b/doc/proc/chirp.html @@ -308,7 +308,7 @@

Contents

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/search.html b/doc/search.html index 61a6b1c1..43568547 100644 --- a/doc/search.html +++ b/doc/search.html @@ -119,7 +119,7 @@

Search Results

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/sourcefile/dynamics.f90.html b/doc/sourcefile/dynamics.f90.html index 5fae3657..f6f4d5bb 100644 --- a/doc/sourcefile/dynamics.f90.html +++ b/doc/sourcefile/dynamics.f90.html @@ -401,7 +401,7 @@

Source Code

Documentation generated by FORD - on 2026-05-26 09:43

+ on 2026-05-27 14:00


diff --git a/doc/tipuesearch/tipuesearch_content.js b/doc/tipuesearch/tipuesearch_content.js index 7241ce88..8a141c7f 100644 --- a/doc/tipuesearch/tipuesearch_content.js +++ b/doc/tipuesearch/tipuesearch_content.js @@ -1 +1 @@ -var tipuesearch = {"pages":[{"title":" DYNAMICS ","text":"DYNAMICS Developer Info Jason Christopherson","tags":"home","loc":"index.html"},{"title":"state_space – DYNAMICS ","text":"type, public :: state_space Defines a state-space representation of a dynamic system. This\nimplementation takes the form: Where: denotes time. is the state vector. is the input vector. is the output vector. Contents Variables A B C D Constructor state_space Type-Bound Procedures evaluate_derivatives evaluate_output poles transfer_function zeros Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:,:) :: A The N-by-N dynamics matrix, where N is the number of state\nvariables. real(kind=real64), public, allocatable, dimension(:,:) :: B The N-by-M input matrix, where M is the number of inputs. real(kind=real64), public, allocatable, dimension(:,:) :: C The P-by-N output matrix, where P is the number of outputs. real(kind=real64), public, allocatable, dimension(:,:) :: D The P-by-M feedthrough matrix. Constructor public interface state_space private pure function state_space_init(m, b, k, n_out) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: m The N-by-N mass matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: b The N-by-N damping matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: k The N-by-N stiffness matrix. integer(kind=int32), intent(in), optional :: n_out The number of outputs. The default is 1. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_scalar(m, b, k) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: m The mass. real(kind=real64), intent(in) :: b The damping. real(kind=real64), intent(in) :: k The stiffness. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_matrices(a, b, c, d) result(rst) Initializes the state space model. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix. real(kind=real64), intent(in), dimension(:,:) :: b The N-by-M input matrix. real(kind=real64), intent(in), dimension(:,:) :: c The P-by-N output matrix. real(kind=real64), intent(in), dimension(:,:) :: d The P-by-M feedthrough matrix. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid(kp, ki, kd, tau, a, b, c, d) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix for the plant. real(kind=real64), intent(in), dimension(size(a, 1), 1) :: b The N-by-1 input matrix for the plant. real(kind=real64), intent(in), dimension(1, size(a, 1)) :: c The 1-by-N output matrix for the plant. real(kind=real64), intent(in), dimension(1, 1) :: d The 1-by-1 feedthrough matrix for the plant. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid_plant(kp, ki, kd, tau, plant) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . class( state_space ), intent(in) :: plant The plant model. Return Value type( state_space ) The resulting [[state_space]] object. Type-Bound Procedures procedure, public :: evaluate_derivatives => ss_eval_deriv private pure function ss_eval_deriv(this, u, x) result(rst) Evaluates the state time derivative . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in), dimension(:) :: u The M-element input array. real(kind=real64), intent(in), dimension(:) :: x The N-element state array. Return Value real(kind=real64), allocatable, dimension(:) The N-element state time derivative vector. procedure, public :: evaluate_output => ss_eval_output private pure function ss_eval_output(this, u, x) result(rst) Evaluates the output vector . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in), dimension(:) :: u The M-element input array. real(kind=real64), intent(in), dimension(:) :: x The N-element state array. Return Value real(kind=real64), allocatable, dimension(:) The P-element output array. procedure, public :: poles => ss_poles private function ss_poles(this, err) result(rst) Computes the poles of the state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The poles of the model. generic, public :: transfer_function => ss_transfer_fcn, ss_transfer_fcn_omega, ss_transfer_fcn_array, ss_transfer_fcn_omega_array private pure function ss_transfer_fcn(this, s) result(rst) Evaluates the transfer functions for the model at the parameter . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. complex(kind=real64), intent(in) :: s The frequency at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:) The resulting transfer functions. private pure function ss_transfer_fcn_omega(this, omega) result(rst) Evaluates the transfer functions for the model at frequency . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in) :: omega The frequency at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:) The resulting transfer functions. private pure function ss_transfer_fcn_array(this, s) result(rst) Evaluates the transfer functions for the model at the frequencies given\nin the array . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. complex(kind=real64), intent(in), dimension(:) :: s The frequencies at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:,:) The resulting transfer functions, with each page of the array \ncontaining the transfer functions for a specific frequency. private pure function ss_transfer_fcn_omega_array(this, omega) result(rst) Evaluates the transfer functions for the model at the frequencies given\nin the array . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in), dimension(:) :: omega The frequencies at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:,:) The resulting transfer functions, with each page of the array \ncontaining the transfer functions for a specific frequency. procedure, public :: zeros => ss_zeros private function ss_zeros(this, err) result(rst) Computes the zeros of the state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The zeros of the model.","tags":"","loc":"type\\state_space.html"},{"title":"transfer_function – DYNAMICS ","text":"type, public :: transfer_function Defines a transfer function for a continuous system of the form . Contents Variables X Y Constructor transfer_function Type-Bound Procedures evaluate poles to_ccf_state_space to_ocf_state_space zeros Components Type Visibility Attributes Name Initial type(polynomial), public :: X The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . type(polynomial), public :: Y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . Constructor public interface transfer_function private function init_tf_array(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . real(kind=real64), intent(in), dimension(:) :: x The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . Return Value type( transfer_function ) The resulting [[transfer_function]]. private function init_tf_poly(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: y The numerator polynomial in . class(polynomial), intent(in) :: x The denominator polynomial in . Return Value type( transfer_function ) The resulting [[transfer_function]]. Type-Bound Procedures generic, public :: evaluate => tf_eval_omega, tf_eval_s private pure elemental function tf_eval_omega(this, omega) result(rst) Evaluates the transfer function at the specified value of the . Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function object. real(kind=real64), intent(in) :: omega The frequency, in rad/s, at which to evaluate the transfer \nfunction. Return Value complex(kind=real64) The value of the transfer function. private pure elemental function tf_eval_s(this, s) result(rst) Evaluates the transfer function at the specified value of the\nLaplace variable . Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function object. complex(kind=real64), intent(in) :: s The Laplace variable at which to evaluate the transfer function. Return Value complex(kind=real64) The value of the transfer function. procedure, public :: poles => tf_poles private function tf_poles(this, err) result(rst) Computes the poles of the transfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The poles of the transfer function. procedure, public :: to_ccf_state_space => tf_to_ccf_statespace private function tf_to_ccf_statespace(this) result(rst) Converts a transfer_function type into a controllable canonical form\nstate_space type. See this article\nfor a description of this form. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function to convert. Return Value type( state_space ) The resulting state-space object. procedure, public :: to_ocf_state_space => tf_to_ocf_statespace private function tf_to_ocf_statespace(this) result(rst) Converts a transfer_function type into an observable canonical form\nstate_space type. See this article\nfor a description of this form. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function to convert. Return Value type( state_space ) The resulting state-space object. procedure, public :: zeros => tf_zeros private function tf_zeros(this, err) result(rst) Computes the zeros of the transfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer function object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The zeros of the transfer function.","tags":"","loc":"type\\transfer_function.html"},{"title":"frf – DYNAMICS ","text":"type, public :: frf A container for a frequency response function, or series of frequency\nresponse functions. Contents Variables frequency responses Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:) :: responses An N-by-M matrix containing the M frequency response functions\nevaluated at each of the N frequency points.","tags":"","loc":"type\\frf.html"},{"title":"mimo_frf – DYNAMICS ","text":"type, public :: mimo_frf A container for the frequency responses of a system of multiple \ninputs and multiple outputs (MIMO). Contents Variables frequency responses Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:,:) :: responses An N-by-M-by-P array containing the frequency response functions\nfor each of the M outputs corresponding to each of the P inputs.","tags":"","loc":"type\\mimo_frf.html"},{"title":"line – DYNAMICS ","text":"type, public :: line Defines the parametric form of a line . Contents Variables r0 v Constructor line Type-Bound Procedures evaluate Components Type Visibility Attributes Name Initial real(kind=real64), public :: r0 (3) The coordinates of the initial point . real(kind=real64), public :: v (3) The vector defining the orientation of the line. Constructor public interface line private pure function line_from_2pts(pt1, pt2) result(rst) Constructs a line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. This point will act as the initial point\nalong the line such that in the\nequation of the line . real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( line ) The resulting line. private pure function line_from_2_planes(p1, p2) result(rst) Constructs a line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function line_from_many_points(pts) result(rst) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts An N-by-3 matrix where N is at least 2, but typically much\nlarger. Return Value type( line ) The resulting line. Type-Bound Procedures procedure, public :: evaluate => line_eval private pure function line_eval(this, t) result(rst) Evaluates the equation of the line at the specified parameter. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: this The line. real(kind=real64), intent(in) :: t The parameter. Return Value real(kind=real64), (3) The location along the line defined by the parameter .","tags":"","loc":"type\\line.html"},{"title":"plane – DYNAMICS ","text":"type, public :: plane Defines a plane as . Contents Variables a b c d Constructor plane Type-Bound Procedures flip_normal Components Type Visibility Attributes Name Initial real(kind=real64), public :: a The x-component of the plane normal vector. real(kind=real64), public :: b The y-component of the plane normal vector. real(kind=real64), public :: c The z-component of the plane normal vector. real(kind=real64), public :: d The offset from the origin. Constructor public interface plane private pure function plane_from_3pts(pt1, pt2, pt3) result(rst) Constructs a plane from 3 points. The 3 points must not be colinear. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. real(kind=real64), intent(in) :: pt3 (3) The third point. Return Value type( plane ) The resulting plane. private pure function plane_from_point_and_normal(pt, nrm) result(rst) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point that lies on the plane. real(kind=real64), intent(in) :: nrm (3) The normal unit vector. Return Value type( plane ) The resulting plane. private pure function plane_from_many_points(pts) result(rst) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts The N-by-3 matrix containing the N points to fit. N must be\nat least 3, but is typically much larger. Return Value type( plane ) The resulting plane. Type-Bound Procedures procedure, public :: flip_normal => plane_flip_normal private subroutine plane_flip_normal(this) Flips the normal vector of the plane. Arguments Type Intent Optional Attributes Name class( plane ), intent(inout) :: this The plane.","tags":"","loc":"type\\plane.html"},{"title":"plucker_line – DYNAMICS ","text":"type, public :: plucker_line Defines a line in 3D Euclidean space using Plücker coordinates. Contents Variables v Constructor plucker_line Type-Bound Procedures m to_array u Components Type Visibility Attributes Name Initial real(kind=real64), public :: v (6) The 6-element array containing the Plücker coordinates. The\nfirst 3 elements contain the unit vector and the last 3 elements\ncontain the moment vector. Constructor public interface plucker_line private pure function pl_from_2pts(pt1, pt2) result(rst) Constructs a new plucker_line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( plucker_line ) The resulting line. private pure function pl_from_line(ln) result(rst) Constructs a new plucker_line from a line object. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln The line. Return Value type( plucker_line ) The equivalent plucker_line. private pure function pl_from_2_planes(p1, p2) result(rst) Constructs a new plucker_line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( plucker_line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function pl_from_array(x, nrm) result(rst) Constructs a new plucker_line from the supplied array. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (6) A 6-element array containing the Plücker coordinates. logical, intent(in), optional :: nrm An optional input that specifies if the first three coordinates\n(the unit vector) should be normalized (true), or left as-is\n(false). The default is true such that the vector is normalized. Return Value type( plucker_line ) The resulting line. Type-Bound Procedures procedure, public :: m => pl_m private pure function pl_m(this) result(rst) The line moment vector. Arguments Type Intent Optional Attributes Name class( plucker_line ), intent(in) :: this The plucker_line object. Return Value real(kind=real64), (3) The moment vector. procedure, public :: to_array => pl_to_array private pure function pl_to_array(this) result(rst) Returns the plucker_line as a 6-element array of the form [u, m]. Arguments Type Intent Optional Attributes Name class( plucker_line ), intent(in) :: this The plucker_line object. Return Value real(kind=real64), (6) The resulting array. procedure, public :: u => pl_u private pure function pl_u(this) result(rst) The unit vector representing the orientation of the line. Arguments Type Intent Optional Attributes Name class( plucker_line ), intent(in) :: this The plucker_line object. Return Value real(kind=real64), (3) The unit vector.","tags":"","loc":"type\\plucker_line.html"},{"title":"coordinate_system – DYNAMICS ","text":"type, public :: coordinate_system Defines a 3D Cartesian coordinate system. Contents Variables i j k origin Constructor coordinate_system Components Type Visibility Attributes Name Initial real(kind=real64), public :: i (3) The unit vector along the coordinate system's x-axis. real(kind=real64), public :: j (3) The unit vector along the coordinate system's y-axis. real(kind=real64), public :: k (3) The unit vector along the coordinate system's z-axis. real(kind=real64), public :: origin (3) The location of the origin of the coordinate system in the parent\ncoordinate system. Constructor public interface coordinate_system private pure function define_link_csys(xim1, zim1, zi, rim1, ri) result(rst) Defines the DH coordinate system for the specified link. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: xim1 (3) The x-axis of the previous link. real(kind=real64), intent(in) :: zim1 (3) The z-axis of the previous link. This is also the axis of the\nproximal joint of the current link. real(kind=real64), intent(in) :: zi (3) The axis of the distal joint of the current link. real(kind=real64), intent(in) :: rim1 (3) The location of the proximal joint's center or home position. real(kind=real64), intent(in) :: ri (3) The location of the distal joint's center or home position. Return Value type( coordinate_system ) The resulting coordinate system. private pure function define_csys(i, j, k, o) result(rst) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The x-axis unit vector. real(kind=real64), intent(in) :: j (3) The y-axis unit vector. real(kind=real64), intent(in) :: k (3) The x-axis unit vector. real(kind=real64), intent(in), optional :: o (3) The location of the coordinate system within a reference \ncoordinate system. If not supplied, a value of (0, 0, 0) will\nbe used. Return Value type( coordinate_system ) The new coordinate_system object.","tags":"","loc":"type\\coordinate_system.html"},{"title":"dh_parameter_set – DYNAMICS ","text":"type, public :: dh_parameter_set Describes a set of Denavit-Hartenberg parameters for a single joint. Contents Variables joint_angle link_length link_offset link_twist Constructor dh_parameter_set Components Type Visibility Attributes Name Initial real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. Constructor public interface dh_parameter_set private pure function dps_init(length, twist, offset, angle) result(rst) Constructs a new dh_parameter_set object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: length The link length. real(kind=real64), intent(in) :: twist The link twist. real(kind=real64), intent(in) :: offset The link offset. real(kind=real64), intent(in) :: angle The joint angle. Return Value type( dh_parameter_set ) The new dh_parameter_set object.","tags":"","loc":"type\\dh_parameter_set.html"},{"title":"dh_table – DYNAMICS ","text":"type, public :: dh_table Describes a Denavit-Hartenberg table. Contents Variables parameters Constructor dh_table Components Type Visibility Attributes Name Initial type( dh_parameter_set ), public, allocatable, dimension(:) :: parameters A collection of DH parameters for each joint in the linkage. Constructor public interface dh_table private pure function dh_table_init(c) result(rst) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Arguments Type Intent Optional Attributes Name class( coordinate_system ), intent(in), dimension(:) :: c An N-element array containing the coordinate frames for each\nof the N links of the linkage. Return Value type( dh_table ) The resulting Denavit-Hartenberg table.","tags":"","loc":"type\\dh_table.html"},{"title":"binary_link – DYNAMICS ","text":"type, public, extends( rigid_body ) :: binary_link Defines a link consisting of only two joints. The coordinate system\nof this link is situated at the distal joint with it's z-axis \ncoincident with the axis of the joint. The link utilizes a\nDenavit-Hartenberg convention in order to express its geometry. Contents Variables cg inertia joint_angle joint_type link_length link_offset link_twist mass Constructor binary_link Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: joint_type The proximal joint type. This value must be either \nREVOLUTE_JOINT or PRISMATIC_JOINT. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the fixed distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. real(kind=real64), public :: mass The mass of the body. Constructor public interface binary_link private pure function bl_init(jtype, length, twist, offset, angle, mass, inertia, cg) result(rst) Initializes a new parallel_revolute_revolute_link instance. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in), optional :: jtype The proximal joint type. This value must be either &\nREVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, \nthis parameter defaults to REVOLUTE_JOINT. real(kind=real64), intent(in), optional :: length The link length. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: twist The link twist angle. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: offset The link offset. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: angle The joint angle offset. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: mass The mass of the link. If no value is specified, a value of 1 is\nused. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not specified, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the distal coordinate\nframe, expressed in the link coordinate frame. If not supplied,\nthe CG is set to (0, 0, 0) such that it is located at the center\nof the distal joint. Return Value type( binary_link ) The resulting binary_link object.","tags":"","loc":"type\\binary_link.html"},{"title":"serial_linkage – DYNAMICS ","text":"type, public :: serial_linkage Defines a serial linkage. Contents Constructor serial_linkage Type-Bound Procedures forward_kinematics get_link get_link_count inverse_kinematics jacobian Constructor public interface serial_linkage private function sl_init(lnks) result(rst) Initializes a new serial_linkage object. Arguments Type Intent Optional Attributes Name class( binary_link ), intent(in), dimension(:) :: lnks A collection of binary_link objects. The collection starts with\nthe first link and progresses to the end-effector in a \nsequential manner. Return Value type( serial_linkage ) The serial_linkage instance. Type-Bound Procedures procedure, public :: forward_kinematics => sl_forward_kinematics private function sl_forward_kinematics(this, q, err) result(rst) Computes the forward kinematics for the linkage resulting in a \ntransformation matrix between world and end-effector coordinate\nframes. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. real(kind=real64), intent(in), dimension(:) :: q The array of joint variables. This array must be the same size\nas there are number of links in this linkage. class(errors), intent(inout), optional, target :: err An errors-based object providing error handling in the event the\narray size is incorrect. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. procedure, public :: get_link => sl_get_link private function sl_get_link(this, i) result(rst) Gets a pointer to the requested link object. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. integer(kind=int32), intent(in) :: i The index of the link to retrieve (1 = first link). Return Value class( binary_link ), pointer A pointer to the requested link. procedure, public :: get_link_count => sl_get_link_count private pure function sl_get_link_count(this) result(rst) Gets the number of links in the linkage. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. Return Value integer(kind=int32) The link count. procedure, public :: inverse_kinematics => sl_inverse_kinematics_1 private function sl_inverse_kinematics_1(this, qo, trg, ib, err) result(rst) Solves the inverse kinematics problem for the linkage. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in), target :: this The serial_linkage object. real(kind=real64), intent(in), dimension(:) :: qo An M-element array containing an initial estimate of the M joint\nvariables. real(kind=real64), intent(in) :: trg (4,4) A transformation matrix relating the end-effector coordinate\nframe and the world coordinate frame. This transformation \nmatrix defines the end-effector target for the solver. type(iteration_behavior), intent(out), optional :: ib An optional output that can be used to gather information on the\nsolver. class(errors), intent(inout), optional, target :: err An optional error handling object used to retrieve any errors\nregarding the solver. Return Value real(kind=real64), allocatable, dimension(:) An M-element array containing the computed joint variables that\nsatisfy the constraints. procedure, public :: jacobian => sl_jacobian private function sl_jacobian(this, q, err) result(rst) Constructs the Jacobian matrix for the linkage. The Jacobian matrix \nrelates the joint velocities to the end-effector \nvelocity by . Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. real(kind=real64), intent(in), dimension(:) :: q The array of joint variables. This array must be the same size\nas there are number of links in this linkage. class(errors), intent(inout), optional, target :: err An errors-based object providing error handling in the event the\narray size is incorrect. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-N Jacobian matrix where N is the number of\nlinks in the linkage.","tags":"","loc":"type\\serial_linkage.html"},{"title":"quaternion – DYNAMICS ","text":"type, public :: quaternion Defines a quaternion of the form: Contents Variables w x y z Constructor quaternion Type-Bound Procedures normalize to_angle_axis to_array to_matrix to_roll_pitch_yaw Components Type Visibility Attributes Name Initial real(kind=real64), public :: w The real component of the quaternion. real(kind=real64), public :: x The first element in the imaginary component of the quaternion. real(kind=real64), public :: y The second element in the imaginary component of the quaternion. real(kind=real64), public :: z The third element in the imaginary component of the quaternion. Constructor public interface quaternion private pure function quat_init_array(x) result(rst) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(4) :: x The array from which to initialize the quaternion stored in the\norder [w, x, y, z]. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_angle_axis(angle, axis) result(rst) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. real(kind=real64), intent(in), dimension(3) :: axis A 3-element vector defining the axis about which the rotation\noccurrs. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_mtx(r) result(rst) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(3, 3) :: r The rotation matrix. Return Value type( quaternion ) The resulting quaternion. Type-Bound Procedures procedure, public :: normalize => quat_normalize private pure subroutine quat_normalize(q) Normalizes the quaternion. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(inout) :: q On input, the quaternion to normalize. On output, the normalized\nquaternion. procedure, public :: to_angle_axis => quat_to_angle_axis private pure subroutine quat_to_angle_axis(q, angle, axis) Converts the quaternion to the equivalent angle-axis form. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. real(kind=real64), intent(out) :: angle The rotation angle, in radians. real(kind=real64), intent(out) :: axis (3) The axis of rotation. procedure, public :: to_array => quat_to_vec4 private pure function quat_to_vec4(q) result(rst) Converts a quaternion to a 4-element array of the form [w, x, y, z]. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(4) The array of the form [w, x, y, z]. procedure, public :: to_matrix => quat_to_matrix private pure function quat_to_matrix(q) result(rst) Converts the quaternion to a 3-by-3 rotation matrix. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(3,3) The resulting rotation matrix. procedure, public :: to_roll_pitch_yaw => quat_to_rpy private pure subroutine quat_to_rpy(q, roll, pitch, yaw) Converts the quaternion to the equivalent Euler angles of roll, \npitch, and yaw. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. real(kind=real64), intent(out) :: roll The roll angle (rotation about the body x-axis), in radians. real(kind=real64), intent(out) :: pitch The pitch angle (rotation about the body y-axis), in radians. real(kind=real64), intent(out) :: yaw The yaw angle (rotation about the body z-axis), in radians.","tags":"","loc":"type\\quaternion.html"},{"title":"rigid_body – DYNAMICS ","text":"type, public :: rigid_body Defines a rigid body. Contents Variables cg inertia mass Constructor rigid_body Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: mass The mass of the body. Constructor public interface rigid_body private pure function rb_init(m, inertia, cg) result(rst) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Return Value type( rigid_body ) The rigid_body object.","tags":"","loc":"type\\rigid_body.html"},{"title":"beam_element_2d – DYNAMICS ","text":"type, public, extends( line_element ) :: beam_element_2d Defines a two-dimensional Bernoulli-Euler beam element. Contents Variables area material moment_of_inertia node_1 node_2 Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count get_terminal_nodes jacobian length mass_matrix rotation_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. real(kind=real64), public :: moment_of_inertia The beam moment of inertia (second moment of area). type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). Type-Bound Procedures procedure, public :: constitutive_matrix => b2d_constitutive_matrix private pure function b2d_constitutive_matrix(this) result(rst) Computes the constitutive matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: evaluate_shape_function => b2d_shape_function private pure function b2d_shape_function(this, i, s) result(rst) Evaluates the i-th shape function at natural coordinate s. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => le_ext_force_vector private pure function le_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure, public :: get_dimensionality => b2d_dimensionality private pure function b2d_dimensionality(this) result(rst) Gets the dimensionality of the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value integer(kind=int32) The dimensionality. procedure, public :: get_dof_per_node => b2d_dof_per_node private pure function b2d_dof_per_node(this) result(rst) Gets the number of degrees of freedom per node. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value integer(kind=int32) The number of DOF per node. procedure, public :: get_node => b2d_get_node private pure function b2d_get_node(this, i) result(rst) Gets the requested node from the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The requested node. procedure, public :: get_node_count => b2d_get_node_count private pure function b2d_get_node_count(this) result(rst) Gets the number of nodes for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value integer(kind=int32) The number of nodes. procedure, public :: get_terminal_nodes => b2d_terminal_nodes private pure subroutine b2d_terminal_nodes(this, i1, i2) Gets the terminal node numbers for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(out) :: i1 The index of the node at the head of the element. integer(kind=int32), intent(out) :: i2 The index of the node at the tail of the element. procedure, public :: jacobian => b2d_jacobian private pure function b2d_jacobian(this, s) result(rst) Computes the Jacobian matrix for a 2D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The Jacobian matrix. procedure, public :: length => le_length private pure function le_length(this) result(rst) Computes the length of the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64) The length of the line element. procedure, public :: mass_matrix => b2d_mass_matrix private pure function b2d_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: rotation_matrix => b2d_rotation_matrix private pure function b2d_rotation_matrix(this) result(rst) Computes the rotation matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-6 rotation matrix. procedure, public :: shape_function_matrix => b2d_shape_function_matrix_2d private pure function b2d_shape_function_matrix_2d(this, s) result(rst) Computes the shape function matrix for a beam element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the shape\nfunctions. Return Value real(kind=real64), allocatable, dimension(:,:) The shape function matrix. procedure, public :: stiffness_matrix => b2d_stiffness_matrix private pure function b2d_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: strain_displacement_matrix => b2d_strain_disp_matrix_2d private pure function b2d_strain_disp_matrix_2d(this, s) result(rst) Computes the strain-displacement matrix for a 2D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The strain-displacement matrix.","tags":"","loc":"type\\beam_element_2d.html"},{"title":"beam_element_3d – DYNAMICS ","text":"type, public, extends( line_element ) :: beam_element_3d Defines a three-dimensional Bernoulli-Euler beam element. Contents Variables Ixx Iyy Izz area material node_1 node_2 orientation_point Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count get_terminal_nodes jacobian length mass_matrix rotation_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial real(kind=real64), public :: Ixx The beam moment of inertia about the element x-axis. real(kind=real64), public :: Iyy The beam moment of inertia about the element y-axis. real(kind=real64), public :: Izz The beam moment of inertia about the element z-axis. real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). type( point ), public :: orientation_point A point used to determine the orientation of the beam in 3D\nspace. The orientation point is measured relative to the first\nnode in the element. Specifically, the element z axis is assumed\nto be defined by the location of this point relative to the\nlocation of node 1. Type-Bound Procedures procedure, public :: constitutive_matrix => b3d_constitutive_matrix private pure function b3d_constitutive_matrix(this) result(rst) Computes the constitutive matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: evaluate_shape_function => b3d_shape_function private pure function b3d_shape_function(this, i, s) result(rst) Evaluates the i-th shape function at natural coordinate s. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => le_ext_force_vector private pure function le_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure, public :: get_dimensionality => b3d_dimensionality private pure function b3d_dimensionality(this) result(rst) Gets the dimensionality of the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value integer(kind=int32) The dimensionality. procedure, public :: get_dof_per_node => b3d_dof_per_node private pure function b3d_dof_per_node(this) result(rst) Gets the number of degrees of freedom per node. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value integer(kind=int32) The number of DOF per node. procedure, public :: get_node => b3d_get_node private pure function b3d_get_node(this, i) result(rst) Gets the requested node from the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The requested node. procedure, public :: get_node_count => b3d_get_node_count private pure function b3d_get_node_count(this) result(rst) Gets the number of nodes for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value integer(kind=int32) The number of nodes. procedure, public :: get_terminal_nodes => b3d_terminal_nodes private pure subroutine b3d_terminal_nodes(this, i1, i2) Gets the terminal node numbers for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(out) :: i1 The index of the node at the head of the element. integer(kind=int32), intent(out) :: i2 The index of the node at the tail of the element. procedure, public :: jacobian => b3d_jacobian private pure function b3d_jacobian(this, s) result(rst) Computes the Jacobian matrix for a 3D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The Jacobian matrix. procedure, public :: length => le_length private pure function le_length(this) result(rst) Computes the length of the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64) The length of the line element. procedure, public :: mass_matrix => b3d_mass_matrix private pure function b3d_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: rotation_matrix => b3d_rotation_matrix private pure function b3d_rotation_matrix(this) result(rst) Computes the rotation matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 12-by-12 rotation matrix. procedure, public :: shape_function_matrix => b3d_shape_function_matrix_3d private pure function b3d_shape_function_matrix_3d(this, s) result(rst) Computes the shape function matrix for a beam element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the shape\nfunctions. Return Value real(kind=real64), allocatable, dimension(:,:) The shape function matrix. procedure, public :: stiffness_matrix => b3d_stiffness_matrix private pure function b3d_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: strain_displacement_matrix => b3d_strain_disp_matrix_3d private pure function b3d_strain_disp_matrix_3d(this, s) result(rst) Computes the strain-displacement matrix for a 3D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The strain-displacement matrix.","tags":"","loc":"type\\beam_element_3d.html"},{"title":"element – DYNAMICS ","text":"type, public, abstract :: element Defines an element. Contents Variables material Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count jacobian mass_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial type( material ), public :: material The material. Type-Bound Procedures procedure(element_const_matrix_function), public, deferred, pass :: constitutive_matrix pure function element_const_matrix_function(this) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_shape_function), public, deferred, pass :: evaluate_shape_function pure function element_shape_function(this, i, s) result(rst) Prototype Defines the signature of a routine for computing the value of\nthe i-th element shape function at natural coordinate. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => e_ext_force_vector private pure function e_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure(element_query), public, deferred, pass :: get_dimensionality pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_query), public, deferred, pass :: get_dof_per_node pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_get_node), public, deferred, pass :: get_node pure function element_get_node(this, i) result(rst) Prototype Defines the signature of a function for retrieving the requested\nnode from the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The node. procedure(element_query), public, deferred, pass :: get_node_count pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_matrix_function), public, deferred, pass :: jacobian pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: mass_matrix => e_mass_matrix private pure function e_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: shape_function_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: stiffness_matrix => e_stiffness_matrix private pure function e_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: strain_displacement_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix.","tags":"","loc":"type\\element.html"},{"title":"line_element – DYNAMICS ","text":"type, public, abstract, extends( element ) :: line_element Defines a line element type. Contents Variables area material Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count get_terminal_nodes jacobian length mass_matrix rotation_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. Type-Bound Procedures procedure(element_const_matrix_function), public, deferred, pass :: constitutive_matrix pure function element_const_matrix_function(this) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_shape_function), public, deferred, pass :: evaluate_shape_function pure function element_shape_function(this, i, s) result(rst) Prototype Defines the signature of a routine for computing the value of\nthe i-th element shape function at natural coordinate. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => le_ext_force_vector private pure function le_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure(element_query), public, deferred, pass :: get_dimensionality pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_query), public, deferred, pass :: get_dof_per_node pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_get_node), public, deferred, pass :: get_node pure function element_get_node(this, i) result(rst) Prototype Defines the signature of a function for retrieving the requested\nnode from the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The node. procedure(element_query), public, deferred, pass :: get_node_count pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(line_element_get_terminal), public, deferred, pass :: get_terminal_nodes pure subroutine line_element_get_terminal(this, i1, i2) Prototype Defines the signature of a routine for returning the terminal\nnode numbers. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. integer(kind=int32), intent(out) :: i1 The index of the node at the head of the element. integer(kind=int32), intent(out) :: i2 The index of the node at the tail of the element. procedure(element_matrix_function), public, deferred, pass :: jacobian pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: length => le_length private pure function le_length(this) result(rst) Computes the length of the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64) The length of the line element. procedure, public :: mass_matrix => le_mass_matrix private pure function le_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(line_element_const_matrix_function), public, deferred, pass :: rotation_matrix pure function line_element_const_matrix_function(this) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: shape_function_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: stiffness_matrix => le_stiffness_matrix private pure function le_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: strain_displacement_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix.","tags":"","loc":"type\\line_element.html"},{"title":"material – DYNAMICS ","text":"type, public :: material Defines a linear-elastic-isotropic material. Contents Variables density modulus poissons_ratio Components Type Visibility Attributes Name Initial real(kind=real64), public :: density The density of the material. real(kind=real64), public :: modulus The modulus of elasticity of the material. real(kind=real64), public :: poissons_ratio The Poisson's ratio of the material.","tags":"","loc":"type\\material.html"},{"title":"node – DYNAMICS ","text":"type, public, extends( point ) :: node Defines a node. Contents Variables dof index x y z Components Type Visibility Attributes Name Initial integer(kind=int32), public :: dof The number of degrees of freeedom associated with this node. integer(kind=int32), public :: index The global index of the node. real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate.","tags":"","loc":"type\\node.html"},{"title":"point – DYNAMICS ","text":"type, public :: point Defines a point in 3D, Cartesian space. Contents Variables x y z Components Type Visibility Attributes Name Initial real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate.","tags":"","loc":"type\\point.html"},{"title":"dynamic_system_measurement – DYNAMICS ","text":"type, public :: dynamic_system_measurement A container of a single measurement data set. Contents Variables input output t Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: input The input data. real(kind=real64), public, allocatable, dimension(:) :: output The output data. real(kind=real64), public, allocatable, dimension(:) :: t The time points at which the measurements were taken.","tags":"","loc":"type\\dynamic_system_measurement.html"},{"title":"model_information – DYNAMICS ","text":"type, public :: model_information A container for model information. Contents Variables excitation model user_info Components Type Visibility Attributes Name Initial class(base_interpolator), public, pointer :: excitation An interpolation object allowing sampling of the excitation \nfunction. real(kind=real64), public, allocatable, dimension(:) :: model An array containing the model parameters. class(*), public, pointer :: user_info Information the user has passed along.","tags":"","loc":"type\\model_information.html"},{"title":"lti_solve – DYNAMICS","text":"public function lti_solve(mdl, u, t, ic, solver, args, err) result(rst) Solves the LTI system given by the specified state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in), target :: mdl The state_space model to solve. procedure( ss_excitation ), intent(in), pointer :: u The routine used to compute the excitation vector. real(kind=real64), intent(in), dimension(:) :: t The time points at which to compute the solution. The array must\nhave at least 2 values; however, more may be specified. If only\n2 values are specified, the integrator will compute the solution at\nthose points, but it will also return any intermediate integration\nsteps that may be required. However, if more than 2 points are\ngiven, the integrator will return the solution values only at the\nspecified time points. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector. This array must be the same size as\nthe number of state variables. class(ode_integrator), intent(in), optional, target :: solver The ODE solver to utilize. If not specified, the default solver\nis a 4th/5th order Runge-Kutta integrator. class(*), intent(inout), optional :: args An optional container for arguments to pass to the excitation\nroutine. class(errors), intent(inout), optional, target :: err An error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The solution. The time points at which the solution was evaluated\nare stored in the first column and the output(s) are stored in the\nremaining column(s). Contents","tags":"","loc":"proc\\lti_solve.html"},{"title":"operator(*) – DYNAMICS","text":"public interface operator(*) Contents Module Procedures tf_tf_mult poly_tf_mult tf_poly_mult tf_scalar_mult scalar_tf_mult Module Procedures private function tf_tf_mult(x, y) result(rst) Multiplies two transfer functions. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function poly_tf_mult(x, y) result(rst) Multiplies a polynomial and a transfer function to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_poly_mult(x, y) result(rst) Multiplies a transfer function and a polynomial to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class(polynomial), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_scalar_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. real(kind=real64), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function scalar_tf_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function.","tags":"","loc":"interface\\operator(ASTERISK).html"},{"title":"ss_excitation – DYNAMICS","text":"interface public subroutine ss_excitation(t, u, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The time value at which to compute the excitation. real(kind=real64), intent(out), dimension(:) :: u The excitation vector. class(*), intent(inout), optional :: args An optional argument used to pass objects in and out of the\nroutine. Description A routine for computing the excitation vector for a state-space\nmodel.","tags":"","loc":"interface\\ss_excitation.html"},{"title":"state_space – DYNAMICS","text":"public interface state_space Contents Module Procedures state_space_init state_space_init_scalar state_space_init_matrices state_space_init_pid state_space_init_pid_plant Module Procedures private pure function state_space_init(m, b, k, n_out) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: m The N-by-N mass matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: b The N-by-N damping matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: k The N-by-N stiffness matrix. integer(kind=int32), intent(in), optional :: n_out The number of outputs. The default is 1. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_scalar(m, b, k) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: m The mass. real(kind=real64), intent(in) :: b The damping. real(kind=real64), intent(in) :: k The stiffness. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_matrices(a, b, c, d) result(rst) Initializes the state space model. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix. real(kind=real64), intent(in), dimension(:,:) :: b The N-by-M input matrix. real(kind=real64), intent(in), dimension(:,:) :: c The P-by-N output matrix. real(kind=real64), intent(in), dimension(:,:) :: d The P-by-M feedthrough matrix. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid(kp, ki, kd, tau, a, b, c, d) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix for the plant. real(kind=real64), intent(in), dimension(size(a, 1), 1) :: b The N-by-1 input matrix for the plant. real(kind=real64), intent(in), dimension(1, size(a, 1)) :: c The 1-by-N output matrix for the plant. real(kind=real64), intent(in), dimension(1, 1) :: d The 1-by-1 feedthrough matrix for the plant. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid_plant(kp, ki, kd, tau, plant) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . class( state_space ), intent(in) :: plant The plant model. Return Value type( state_space ) The resulting [[state_space]] object.","tags":"","loc":"interface\\state_space.html"},{"title":"transfer_function – DYNAMICS","text":"public interface transfer_function Contents Module Procedures init_tf_array init_tf_poly Module Procedures private function init_tf_array(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . real(kind=real64), intent(in), dimension(:) :: x The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . Return Value type( transfer_function ) The resulting [[transfer_function]]. private function init_tf_poly(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: y The numerator polynomial in . class(polynomial), intent(in) :: x The denominator polynomial in . Return Value type( transfer_function ) The resulting [[transfer_function]].","tags":"","loc":"interface\\transfer_function.html"},{"title":"report_array_index_out_of_bounds_error – DYNAMICS","text":"public subroutine report_array_index_out_of_bounds_error(name, var, ind, sz, err) Reports an array index-out-of-bounds error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The offending index. integer(kind=int32), intent(in) :: sz The array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_array_index_out_of_bounds_error.html"},{"title":"report_array_size_error – DYNAMICS","text":"public subroutine report_array_size_error(name, var, expected, actual, err) Reports an array size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expected The expected array size. integer(kind=int32), intent(in) :: actual The actual array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_array_size_error.html"},{"title":"report_constraint_count_error – DYNAMICS","text":"public subroutine report_constraint_count_error(name, expected, actual, err) Reports an error associated with an incorrect number of constraints. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: expected The expected number of constraints. integer(kind=int32), intent(in) :: actual The actual number of constraints. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_constraint_count_error.html"},{"title":"report_convergence_error – DYNAMICS","text":"public subroutine report_convergence_error(name, niter, resid, err) Reports a convergence error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: niter The actual number of iterations taken. real(kind=real64), intent(in) :: resid The current residual estimate. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=512), public :: errmsg","tags":"","loc":"proc\\report_convergence_error.html"},{"title":"report_generic_counting_error – DYNAMICS","text":"public subroutine report_generic_counting_error(name, str1, val, str2, flag, err) A generic error reporting routine. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: str1 The first string. integer(kind=int32), intent(in) :: val The integer value. character(len=*), intent(in) :: str2 The second string. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=512), public :: errmsg","tags":"","loc":"proc\\report_generic_counting_error.html"},{"title":"report_matrix_size_error – DYNAMICS","text":"public subroutine report_matrix_size_error(name, var, expect_rows, expect_cols, actual_rows, actual_cols, err) Reports a matrix size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expect_rows The expected number of rows. integer(kind=int32), intent(in) :: expect_cols The expected number of columns. integer(kind=int32), intent(in) :: actual_rows The actual number of rows. integer(kind=int32), intent(in) :: actual_cols The actual number of columns. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=512), public :: errmsg","tags":"","loc":"proc\\report_matrix_size_error.html"},{"title":"report_matrix_size_mismatch_error – DYNAMICS","text":"public subroutine report_matrix_size_mismatch_error(name, mtx1, mtx2, m1, n1, m2, n2, err) Reports a mismatch in matrix sizes. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: mtx1 The name of the first matrix. character(len=*), intent(in) :: mtx2 The name of the second matrix. integer(kind=int32), intent(in) :: m1 The number of rows in the first matrix. integer(kind=int32), intent(in) :: n1 The number of columns in the first matrix. integer(kind=int32), intent(in) :: m2 The number of rows in the second matrix. integer(kind=int32), intent(in) :: n2 The number of columns in the second matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_matrix_size_mismatch_error.html"},{"title":"report_memory_error – DYNAMICS","text":"public subroutine report_memory_error(name, flag, err) Reports a memory allocation error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: flag The flag returned from the allocate statement. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_memory_error.html"},{"title":"report_nonmonotonic_array_error – DYNAMICS","text":"public subroutine report_nonmonotonic_array_error(name, var, ind, err) Reports a nonmonotonic array error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The index of the occurrence of nonmonotonicity. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonmonotonic_array_error.html"},{"title":"report_nonsquare_mass_matrix_error – DYNAMICS","text":"public subroutine report_nonsquare_mass_matrix_error(name, m, n, err) Reports an error relating to a non-square mass matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the mass matrix. integer(kind=int32), intent(in) :: n The number of columns found in the mass matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonsquare_mass_matrix_error.html"},{"title":"report_nonsquare_matrix_error – DYNAMICS","text":"public subroutine report_nonsquare_matrix_error(name, var, m, n, err) Reports an error relating to a non-square matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: m The number of rows found in the matrix. integer(kind=int32), intent(in) :: n The number of columns found in the matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonsquare_matrix_error.html"},{"title":"report_nonsquare_stiffness_matrix_error – DYNAMICS","text":"public subroutine report_nonsquare_stiffness_matrix_error(name, m, n, err) Reports an error relating to a non-square stiffness matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the stiffness matrix. integer(kind=int32), intent(in) :: n The number of columns found in the stiffness matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonsquare_stiffness_matrix_error.html"},{"title":"report_null_forcing_routine_error – DYNAMICS","text":"public subroutine report_null_forcing_routine_error(name, err) Reports a null forcing routine pointer error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents","tags":"","loc":"proc\\report_null_forcing_routine_error.html"},{"title":"report_null_solver_routine_error – DYNAMICS","text":"public subroutine report_null_solver_routine_error(name, err) Reports a null solver routine error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents","tags":"","loc":"proc\\report_null_solver_routine_error.html"},{"title":"report_overconstraint_error – DYNAMICS","text":"public subroutine report_overconstraint_error(name, err) Reports an overconstraint error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents","tags":"","loc":"proc\\report_overconstraint_error.html"},{"title":"report_zero_difference_error – DYNAMICS","text":"public subroutine report_zero_difference_error(name, var1, val1, var2, val2, flag, err) Reports a zero-difference between two variables where a non-zero\ndifference was expected. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var1 The name of the first variable. real(kind=real64), intent(in) :: val1 The value of the first variable. character(len=*), intent(in) :: var2 The name of the second variable. real(kind=real64), intent(in) :: val2 The value of the second variable. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_zero_difference_error.html"},{"title":"report_zero_valued_frequency_error – DYNAMICS","text":"public subroutine report_zero_valued_frequency_error(name, index, err) Reports an error associated with a zero-valued frequency value. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: index The array index at which the zero-valued frequency was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_zero_valued_frequency_error.html"},{"title":"chirp – DYNAMICS","text":"public pure elemental function chirp(t, amp, span, f1Hz, f2Hz) result(rst) Evaluates a linear chirp function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate the \nchirp. real(kind=real64), intent(in) :: amp The amplitude. real(kind=real64), intent(in) :: span The duration of the time it takes to sweep from the start \nfrequency to the end frequency. real(kind=real64), intent(in) :: f1Hz The lower excitation frequency, in Hz. real(kind=real64), intent(in) :: f2Hz The upper excitation frequency, in Hz. Return Value real(kind=real64) The value of the function at t. Contents","tags":"","loc":"proc\\chirp.html"},{"title":"compute_modal_damping – DYNAMICS","text":"public pure elemental function compute_modal_damping(lambda, alpha, beta) result(rst) Computes the modal damping factors given the\nproportional damping terms and where , , and is the eigenvalue of the system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: lambda The square of the modal frequency - the eigen value. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . Return Value real(kind=real64) The modal damping parameter. Contents","tags":"","loc":"proc\\compute_modal_damping.html"},{"title":"fit_frf – DYNAMICS","text":"public function fit_frf(mt, n, freq, rsp, maxp, minp, init, stats, alpha, controls, settings, info, err) result(rst) Uses peaks Fits an experimentally obtained frequency response by model for either a\nreceptance model: or an accelerance model: . Internally, the code uses a Levenberg-Marquardt solver to determine the\nparameters. The initial guess for the solver is determined by a \npeak finding algorithm used to locate the resonant modes in frequency.\nfrom this result, estimates for both the amplitude and natural frequency\nvalues are obtained. The damping parameters are assumed to be equal\nfor all modes and set to a default value of 0.1. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: mt The excitation method. The options are as follows. FRF_ACCELERANCE_MODEL: Use an accelerance model. FRF_RECEPTANCE_MODEL: Use a receptance model. integer(kind=int32), intent(in) :: n The model order (# of resonant modes). real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the excitation frequency values in \nunits of rad/s. complex(kind=real64), intent(in), dimension(:) :: rsp An M-element array containing the frequency response to fit. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional 3*N-element array that can be used as upper limits on \nthe parameter values. If no upper limit is requested for a particular\nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional 3*N-element array that can be used as lower limits on \nthe parameter values. If no lower limit is requested for a particalar\nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: init An optional 3 N-element array that, if supplied, provides an initial\nguess for each of the 3 N model parameters for the iterative solver.\nIf supplied, this array replaces the peak finding algorithm for\nestimating an initial guess. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional 3*N-element array that, if supplied, will be used to\nreturn statistics about the fit for each model parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence intervals.\nThe default value is 0.05 such that a 95% confidence interval is \ncalculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if freq and rsp are not the same size. DYN_UNDERDEFINED_PROBLEM_EROR: Occurs if the requested model \n order is too high for the number of data points available. DYN_TOLERANCE_TOO_SMALL_ERROR: Occurs if the requested solver \n tolerance is too small to be practical for this problem. DYN_TOO_FEW_ITERATIONS_ERROR: Occurs if convergence cannot be \n achieved in the allowed number of solver iterations. Return Value real(kind=real64), allocatable, dimension(:) An array containing the model parameters stored as . Contents","tags":"","loc":"proc\\fit_frf.html"},{"title":"modal_response – DYNAMICS","text":"public subroutine modal_response(mass, stiff, freqs, modeshapes, err) Uses linalg dynamics_error_handling Computes the modal frequencies and modes shapes for \nmulti-degree-of-freedom system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must\nbe symmetric. real(kind=real64), intent(out), allocatable, dimension(:) :: freqs An allocatable N-element array where the modal frequencies will\nbe returned in ascending order with units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional, allocatable N-by-N matrix where the N mode shapes\nfor the system will be returned. The mode shapes are stored in\ncolumns. class(errors), intent(inout), optional, target :: err Contents","tags":"","loc":"proc\\modal_response.html"},{"title":"normalize_mode_shapes – DYNAMICS","text":"public subroutine normalize_mode_shapes(x) Normalizes mode shape vectors such that the largest magnitude\nvalue in the vector is one. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), dimension(:,:) :: x The matrix of mode shape vectors with one vector per column. Contents","tags":"","loc":"proc\\normalize_mode_shapes.html"},{"title":"evaluate_accelerance_frf_model – DYNAMICS","text":"public interface evaluate_accelerance_frf_model Contents Module Procedures evaluate_accelerance_frf_model_scalar evaluate_accelerance_frf_model_array Module Procedures private pure function evaluate_accelerance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_accelerance_frf_model_array(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function.","tags":"","loc":"interface\\evaluate_accelerance_frf_model.html"},{"title":"evaluate_receptance_frf_model – DYNAMICS","text":"public interface evaluate_receptance_frf_model Contents Module Procedures evaluate_receptance_frf_model_scalar evaluate_receptance_frf_model_array Module Procedures private pure function evaluate_receptance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_receptance_frf_model_array(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function.","tags":"","loc":"interface\\evaluate_receptance_frf_model.html"},{"title":"frequency_response – DYNAMICS","text":"public interface frequency_response Computes the frequency response functions for a system of ODE's. Contents Module Procedures frf_modal_prop_damp frf_modal_prop_damp_2 siso_freqres mimo_freqres Module Procedures private function frf_modal_prop_damp(mass, stiff, alpha, beta, freq, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . real(kind=real64), intent(in), dimension(:) :: freq An M-element array of frequency values at which to evaluate the\nfrequency response functions, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function frf_modal_prop_damp_2(mass, stiff, alpha, beta, nfreq, freq1, freq2, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency, in units of rad/s. real(kind=real64), intent(in) :: freq2 The ending frequency, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function siso_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency response of a single-input, single-output (SISO)\nsystem. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the excitation signal. real(kind=real64), intent(in), dimension(:) :: y An N-element array containing the response signal. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size. Return Value type( frf ) The resulting frequency response function. private function mimo_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency responses of a multiple-input, multiple-output\n(MIMO) system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x An N-by-P array containing the P inputs to the system. real(kind=real64), intent(in), dimension(:,:) :: y An N-by-M array containing the M outputs from the system. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y do not have the same number\n of rows. Return Value type( mimo_frf ) The resulting frequency response functions.","tags":"","loc":"interface\\frequency_response.html"},{"title":"frequency_sweep – DYNAMICS","text":"public interface frequency_sweep Contents Module Procedures frf_sweep_1 frf_sweep_2 Module Procedures private function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, points, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the frequency points at which the \nsolution should be computed. Notice, whatever units are utilized\nfor this array are also the units of the excitation_frequency\nproperty in @p sys. It is recommended that the units be set to \nHz. Additionally, this array cannot contain any zero-valued \nelements as the ODE solution time for each frequency is \ndetermined by the period of oscillation and number of cycles. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 20. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 200. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. Notice, there must be at least 2 points per cycle for the\nanalysis to be effective. The algorithm utilizes a discrete \nFourier transform to determine the phase and amplitude, and in \norder to satisfy Nyquist conditions, the value must be at least \n2. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses. private function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, ntransient, points, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency. It is recommended that the units be set\nto Hz. real(kind=real64), intent(in) :: freq2 The ending frequency. It is recommended that the units be set to\nHz. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 20. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 200. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. Notice, there must be at least 2 points per cycle for the\nanalysis to be effective. The algorithm utilizes a discrete \nFourier transform to determine the phase and amplitude, and in \norder to satisfy Nyquist conditions, the value must be at least \n2. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses.","tags":"","loc":"interface\\frequency_sweep.html"},{"title":"harmonic_ode – DYNAMICS","text":"interface public subroutine harmonic_ode(freq, t, x, dxdt, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. real(kind=real64), intent(in) :: t The current time step value. real(kind=real64), intent(in), dimension(:) :: x The value of the solution estimate at time t. real(kind=real64), intent(out), dimension(:) :: dxdt The derivatives as computed by this routine. class(*), intent(inout), optional :: args An optional argument allowing the passing of data in/out of\nthis routine. Description Defines a system of ODE's exposed to harmonic excitation.","tags":"","loc":"interface\\harmonic_ode.html"},{"title":"modal_excite – DYNAMICS","text":"interface public subroutine modal_excite(freq, frc, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. When used as a part of a frequency\nresponse calculation, this value will have the same units as\nthe frequency values provided to the frequency response\nroutine. complex(kind=real64), intent(out), dimension(:) :: frc An N-element array where the forcing function should be\nwritten. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. Description Defines the interface to a routine for defining the forcing\nfunction for a modal frequency analysis.","tags":"","loc":"interface\\modal_excite.html"},{"title":"ode_excite – DYNAMICS","text":"interface public function ode_excite(t) result(rst) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate\nthe excitation function. Return Value real(kind=real64) The result. Description Defines the interface for a ODE excitation function.","tags":"","loc":"interface\\ode_excite.html"},{"title":"is_point_on_line – DYNAMICS","text":"public pure function is_point_on_line(pt, ln, tol) result(rst) Tests to see if a point lies on a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the line; else, false. Contents","tags":"","loc":"proc\\is_point_on_line.html"},{"title":"is_point_on_plane – DYNAMICS","text":"public pure function is_point_on_plane(pt, pln, tol) result(rst) Tests to see if a point lies on a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the plane; else, false. Contents","tags":"","loc":"proc\\is_point_on_plane.html"},{"title":"line_common_normal – DYNAMICS","text":"public pure function line_common_normal(ln1, ln2) result(rst) Returns the common normal line between two lines pointing from ln1 to\nln2. In the event that the two lines are parallel within the \nspecified tolerance, there exist an infinite number of common \nnormals; therefore, a line will be chosen that runs from ln1 to ln2\nwith the point at t = 0 coincident with the point at t = 0 on ln1. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. Return Value type( line ) The common normal line. The distance along this line between\nt = 0 and t = 1 defines the length of the common normal \nconnecting ln1 to ln2. In the event that ln1 and ln2 intersect,\nthe length of this line is zero. Contents","tags":"","loc":"proc\\line_common_normal.html"},{"title":"line_from_point_and_vector – DYNAMICS","text":"public pure function line_from_point_and_vector(pt, x, nx) result(rst) Constructs a new line from a point (defines the point where t = 0)\nand a direction vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point at which t = 0 on the line. real(kind=real64), intent(in) :: x (3) The direction vector defining the orientation of the line. logical, intent(in), optional :: nx An optional parameter that defines if x should be normalized to\na unit vector (true), or left as-is (false). The default is\ntrue such that x is normalized to a unit vector. Return Value type( line ) The resulting line. Contents","tags":"","loc":"proc\\line_from_point_and_vector.html"},{"title":"nearest_point_on_line – DYNAMICS","text":"public pure function nearest_point_on_line(pt, ln) result(rst) Gets the line parameter for the point on the line nearest the \nspecified point. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The line parameteric variable defining the location of\nthe point nearest along the line. Contents","tags":"","loc":"proc\\nearest_point_on_line.html"},{"title":"plane_normal – DYNAMICS","text":"public pure function plane_normal(pln) result(rst) Returns the normal vector of a plane. Arguments Type Intent Optional Attributes Name type( plane ), intent(in) :: pln The plane. Return Value real(kind=real64), (3) The normal vector. Contents","tags":"","loc":"proc\\plane_normal.html"},{"title":"point_plane_projection – DYNAMICS","text":"public pure function point_plane_projection(pt, pln) result(rst) Projects a point onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane onto which to project the point. Return Value real(kind=real64), (3) The projected point. Contents","tags":"","loc":"proc\\point_plane_projection.html"},{"title":"point_to_line_distance – DYNAMICS","text":"public pure function point_to_line_distance(pt, ln) result(rst) Computes the shortest distance between a point and a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The shortest distance between the point and line. Contents","tags":"","loc":"proc\\point_to_line_distance.html"},{"title":"point_to_plane_distance – DYNAMICS","text":"public pure function point_to_plane_distance(pt, pln) result(rst) Computes the shortest distance between a point and a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. Return Value real(kind=real64) The shortest distance between the point and plane. Contents","tags":"","loc":"proc\\point_to_plane_distance.html"},{"title":"vector_plane_projection – DYNAMICS","text":"public pure function vector_plane_projection(x, pln) result(rst) Projects a vector onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector to project. class( plane ), intent(in) :: pln The plane onto which to project the vector. Return Value real(kind=real64), (3) The projected vector. Contents","tags":"","loc":"proc\\vector_plane_projection.html"},{"title":"do_lines_intersect – DYNAMICS","text":"public pure subroutine do_lines_intersect(ln1, ln2, intersect, t1, t2, tol) Tests to see if two lines intersect. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. logical, intent(out) :: intersect True if the two lines intersect within the specified tolerance;\nelse, false if they do not intersect. real(kind=real64), intent(out), optional :: t1 The parametric value associate with ln1 defining the intersection\npoint. real(kind=real64), intent(out), optional :: t2 The parametric value associate with ln2 defining the intersection\npoint. real(kind=real64), intent(in), optional :: tol The intersection tolerance. If not supplied, the default value\nis 10x machine epsilon. Contents","tags":"","loc":"proc\\do_lines_intersect.html"},{"title":"assignment(=) – DYNAMICS","text":"public interface assignment(=) Contents Module Procedures plane_assign line_assign pl_assign pl_assign_line Module Procedures private pure elemental subroutine plane_assign(x, y) Assigns a plane to another. Arguments Type Intent Optional Attributes Name type( plane ), intent(out) :: x The resulting plane. type( plane ), intent(in) :: y The source plane private pure elemental subroutine line_assign(x, y) Assigns a line to another. Arguments Type Intent Optional Attributes Name type( line ), intent(out) :: x The resulting line. type( line ), intent(in) :: y The source line private pure elemental subroutine pl_assign(x, y) Assigns a plucker_line to another. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( plucker_line ), intent(in) :: y The source plucker_line. private pure elemental subroutine pl_assign_line(x, y) Assigns a line to a plucker_line. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( line ), intent(in) :: y The source line.","tags":"","loc":"interface\\assignment(=).html"},{"title":"is_parallel – DYNAMICS","text":"public interface is_parallel Contents Module Procedures is_parallel_vectors is_parallel_lines is_parallel_planes Module Procedures private pure function is_parallel_vectors(x, y, tol) result(rst) Tests to see if two vectors are parallel. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the vectors are parallel; else, false. private pure function is_parallel_lines(x, y, tol) result(rst) Tests to see if two lines are parallel. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: x The first line. class( line ), intent(in) :: y The second line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the lines are parallel; else, false. private pure function is_parallel_planes(x, y, tol) result(rst) Tests to see if two planes are parallel. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: x The first plane. class( plane ), intent(in) :: y The second plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the planes are parallel; else, false.","tags":"","loc":"interface\\is_parallel.html"},{"title":"line – DYNAMICS","text":"public interface line Contents Module Procedures line_from_2pts line_from_2_planes line_from_many_points Module Procedures private pure function line_from_2pts(pt1, pt2) result(rst) Constructs a line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. This point will act as the initial point\nalong the line such that in the\nequation of the line . real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( line ) The resulting line. private pure function line_from_2_planes(p1, p2) result(rst) Constructs a line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function line_from_many_points(pts) result(rst) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts An N-by-3 matrix where N is at least 2, but typically much\nlarger. Return Value type( line ) The resulting line.","tags":"","loc":"interface\\line.html"},{"title":"matmul – DYNAMICS","text":"public interface matmul Contents Module Procedures pl_matmul Module Procedures private pure function pl_matmul(x, y) result(rst) Overloads the matmul routine to allow for multiplication of the\nPlücker line coordinate vector with a matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x The N-by-6 matrix. type( plucker_line ), intent(in) :: y The plucker_line object. Return Value real(kind=real64), allocatable, dimension(:) The resulting N-element array.","tags":"","loc":"interface\\matmul.html"},{"title":"plane – DYNAMICS","text":"public interface plane Contents Module Procedures plane_from_3pts plane_from_point_and_normal plane_from_many_points Module Procedures private pure function plane_from_3pts(pt1, pt2, pt3) result(rst) Constructs a plane from 3 points. The 3 points must not be colinear. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. real(kind=real64), intent(in) :: pt3 (3) The third point. Return Value type( plane ) The resulting plane. private pure function plane_from_point_and_normal(pt, nrm) result(rst) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point that lies on the plane. real(kind=real64), intent(in) :: nrm (3) The normal unit vector. Return Value type( plane ) The resulting plane. private pure function plane_from_many_points(pts) result(rst) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts The N-by-3 matrix containing the N points to fit. N must be\nat least 3, but is typically much larger. Return Value type( plane ) The resulting plane.","tags":"","loc":"interface\\plane.html"},{"title":"plucker_line – DYNAMICS","text":"public interface plucker_line Contents Module Procedures pl_from_2pts pl_from_line pl_from_2_planes pl_from_array Module Procedures private pure function pl_from_2pts(pt1, pt2) result(rst) Constructs a new plucker_line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( plucker_line ) The resulting line. private pure function pl_from_line(ln) result(rst) Constructs a new plucker_line from a line object. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln The line. Return Value type( plucker_line ) The equivalent plucker_line. private pure function pl_from_2_planes(p1, p2) result(rst) Constructs a new plucker_line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( plucker_line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function pl_from_array(x, nrm) result(rst) Constructs a new plucker_line from the supplied array. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (6) A 6-element array containing the Plücker coordinates. logical, intent(in), optional :: nrm An optional input that specifies if the first three coordinates\n(the unit vector) should be normalized (true), or left as-is\n(false). The default is true such that the vector is normalized. Return Value type( plucker_line ) The resulting line.","tags":"","loc":"interface\\plucker_line.html"},{"title":"cross_product – DYNAMICS","text":"public pure function cross_product(x, y) result(rst) Computes the cross-product of a vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The left-hand-side argument. real(kind=real64), intent(in) :: y (3) The right-hand-side argument Return Value real(kind=real64), (3) The resulting vector. Contents","tags":"","loc":"proc\\cross_product.html"},{"title":"scalar_projection – DYNAMICS","text":"public pure function scalar_projection(x, y) result(rst) Computes the projection of vector x onto vector y. The scalar projection\nis defined such that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64) The scalar projection of x onto y. Contents","tags":"","loc":"proc\\scalar_projection.html"},{"title":"to_skew_symmetric – DYNAMICS","text":"public pure function to_skew_symmetric(x) result(rst) Converts a 3-element vector to a 3-by-3 skew-symmetric matrix. A \nskew-symmetric matrix is defined as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector. Return Value real(kind=real64), (3,3) The resulting skew-symmetric matrix. Contents","tags":"","loc":"proc\\to_skew_symmetric.html"},{"title":"vector_angle – DYNAMICS","text":"public pure function vector_angle(x, y) result(rst) Computes the angle between two vectors. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. Return Value real(kind=real64) The angle, in radians. Contents","tags":"","loc":"proc\\vector_angle.html"},{"title":"vector_projection – DYNAMICS","text":"public pure function vector_projection(x, y) result(rst) Computes the vector pojection of vector x onto vector y. The vector\nprojection is defined such that Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64), (3) The vector projection of x onto y. Contents","tags":"","loc":"proc\\vector_projection.html"},{"title":"dh_matrix – DYNAMICS","text":"public pure function dh_matrix(alpha, a, theta, d) result(rst) Computes the Denavit-Hartenberg transformation matrix for the \nspecified DH parameters. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The link twist angle, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in) :: a The link length as measured along the link's x-axis. real(kind=real64), intent(in) :: theta The joint angle, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in) :: d The joint offset distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. Contents","tags":"","loc":"proc\\dh_matrix.html"},{"title":"dh_rotate_x – DYNAMICS","text":"public pure function dh_rotate_x(alpha) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_rotate_x.html"},{"title":"dh_rotate_z – DYNAMICS","text":"public pure function dh_rotate_z(theta) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: theta The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_rotate_z.html"},{"title":"dh_translate_x – DYNAMICS","text":"public pure function dh_translate_x(a) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a The translation. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_translate_x.html"},{"title":"dh_translate_z – DYNAMICS","text":"public pure function dh_translate_z(d) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d The translation. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_translate_z.html"},{"title":"identity_4 – DYNAMICS","text":"public pure function identity_4() result(rst) Computes a 4-by-4 identity matrix. Arguments None Return Value real(kind=real64), (4,4) The resulting identity matrix. Contents None","tags":"","loc":"proc\\identity_4.html"},{"title":"jacobian_generating_vector – DYNAMICS","text":"public pure function jacobian_generating_vector(d, k, R, jtype) result(rst) Computes a single Jacobian generating vector given the position vector\nof the link origin, , and the joint axis unit vector, . For a revolute joint: For a prismatic joint: The Jacobian matrix is then constructed from the Jacobian generating\nvectors as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d (3) The position vector of the end-effector, , relative to the\nlink coordinate frame given in the base coordinate frame. An easy\nway to compute this vector is to extract the first 3 elements of the\n4th column of the transformation matrix: . real(kind=real64), intent(in) :: k (3) The unit vector defining the joint axis, , given in the\nbase coordinate frame. This vector can be computed most easily by\nusing the transformation matrix: and\nthen computing . real(kind=real64), intent(in) :: R (3,3) The rotation matrix defining the orientation of the link coordinate\nframe relative to the base coordinate frame. integer(kind=int32), intent(in) :: jtype The joint type. Must be either REVOLUTE_JOINT or PRISMATIC_JOINT.\nIf incorrectly specified, the code defaults to a REVOLUTE_JOINT type. Return Value real(kind=real64), (6) The resulting 6-element Jacobian generating vector. Contents","tags":"","loc":"proc\\jacobian_generating_vector.html"},{"title":"solve_inverse_kinematics – DYNAMICS","text":"public function solve_inverse_kinematics(mdl, qo, constraints, df, slvr, ib, jfcn, qmax, qmin, args, err) result(rst) Solves the inverse kinematics problem for a linkage. An iterative\nsolution procedure is utilized. Arguments Type Intent Optional Attributes Name procedure(vecfcn), intent(in), pointer :: mdl A routine used to compute the forward kinematics for the linkage\ngiven the current joint variable estimates. real(kind=real64), intent(in), dimension(:) :: qo An M-element array containing an initial estimate of the M joint\nvariables. real(kind=real64), intent(in), target, dimension(:) :: constraints An N-element array containing the target values (constraints) for\neach of the N kinematic equations in the model. N must be at \nleast equal to M (the number of joint variables). real(kind=real64), intent(out), optional, target, dimension(:) :: df An optional N-element array that, if supplied, can be used to \nretrieve the residuals of each of the N kinematic equations. class(constrained_equation_solver), intent(inout), optional, target :: slvr An optional solver that can be used in place of the default\nLevenberg-Marquardt solver. type(iteration_behavior), intent(out), optional :: ib An optional output that can be used to gather information on the\nsolver. procedure(jacobianfcn), intent(in), optional, pointer :: jfcn A routine that can be used to provide the Jacobian matrix for\nthe linkage. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmax An optional set of upper limits on each of the joint variables.\nIf not provided, the default is the output of the 'huge' \nintrinsic function. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmin An optional set of lower limits on each of the joint variables.\nIf not provided, the default is the negative of the output of \nthe 'huge' intrinsic function. class(*), intent(inout), optional, target :: args An optional argument that can be used to communicate with mdl. class(errors), intent(inout), optional, target :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Return Value real(kind=real64), allocatable, dimension(:) An M-element array containing the computed joint variables. Contents","tags":"","loc":"proc\\solve_inverse_kinematics.html"},{"title":"coordinate_system – DYNAMICS","text":"public interface coordinate_system Contents Module Procedures define_link_csys define_csys Module Procedures private pure function define_link_csys(xim1, zim1, zi, rim1, ri) result(rst) Defines the DH coordinate system for the specified link. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: xim1 (3) The x-axis of the previous link. real(kind=real64), intent(in) :: zim1 (3) The z-axis of the previous link. This is also the axis of the\nproximal joint of the current link. real(kind=real64), intent(in) :: zi (3) The axis of the distal joint of the current link. real(kind=real64), intent(in) :: rim1 (3) The location of the proximal joint's center or home position. real(kind=real64), intent(in) :: ri (3) The location of the distal joint's center or home position. Return Value type( coordinate_system ) The resulting coordinate system. private pure function define_csys(i, j, k, o) result(rst) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The x-axis unit vector. real(kind=real64), intent(in) :: j (3) The y-axis unit vector. real(kind=real64), intent(in) :: k (3) The x-axis unit vector. real(kind=real64), intent(in), optional :: o (3) The location of the coordinate system within a reference \ncoordinate system. If not supplied, a value of (0, 0, 0) will\nbe used. Return Value type( coordinate_system ) The new coordinate_system object.","tags":"","loc":"interface\\coordinate_system.html"},{"title":"dh_forward_kinematics – DYNAMICS","text":"public interface dh_forward_kinematics Contents Module Procedures dh_forward_kinematics_2 dh_forward_kinematics_3 dh_forward_kinematics_4 dh_forward_kinematics_5 dh_forward_kinematics_6 dh_forward_kinematics_7 dh_forward_kinematics_8 dh_forward_kinematics_array dh_forward_kinematics_dh_params dh_forward_kinematics_dh_table Module Procedures private pure function dh_forward_kinematics_2(T1, T2) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_3(T1, T2, T3) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_4(T1, T2, T3, T4) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_5(T1, T2, T3, T4, T5) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_6(T1, T2, T3, T4, T5, T6) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_7(T1, T2, T3, T4, T5, T6, T7) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_8(T1, T2, T3, T4, T5, T6, T7, T8) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. real(kind=real64), intent(in) :: T8 (4,4) The transformation matrix for the eigth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_array(alpha, a, theta, d) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. The first entry must\nbe from the first link nearest ground. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_params(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_parameter_set ), intent(in), dimension(:) :: x The list of DH parameters. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_table(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_table ), intent(in) :: x The DH table. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix.","tags":"","loc":"interface\\dh_forward_kinematics.html"},{"title":"dh_jacobian – DYNAMICS","text":"public interface dh_jacobian Contents Module Procedures dh_build_jacobian Module Procedures private function dh_build_jacobian(alpha, a, theta, d, jtypes) result(rst) Builds the Jacobian matrix for a linkage given the Denavit-Hartenberg\nparameters. The first entry in each array must be from the first link\nnearest ground. The Jacobian matrix relates the joint velocities to the end-effector velocity by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. integer(kind=int32), intent(in), dimension(size(alpha)) :: jtypes The types of each joint. Must be either REVOLUTE_JOINT or\nPRISMATIC_JOINT. The code defaults to REVOLUTE_JOINT. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-N Jacobian matrix where N is the number of joint\nvariables (i.e. the length of the input arrays).","tags":"","loc":"interface\\dh_jacobian.html"},{"title":"dh_parameter_set – DYNAMICS","text":"public interface dh_parameter_set Contents Module Procedures dps_init Module Procedures private pure function dps_init(length, twist, offset, angle) result(rst) Constructs a new dh_parameter_set object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: length The link length. real(kind=real64), intent(in) :: twist The link twist. real(kind=real64), intent(in) :: offset The link offset. real(kind=real64), intent(in) :: angle The joint angle. Return Value type( dh_parameter_set ) The new dh_parameter_set object.","tags":"","loc":"interface\\dh_parameter_set.html"},{"title":"dh_table – DYNAMICS","text":"public interface dh_table Contents Module Procedures dh_table_init Module Procedures private pure function dh_table_init(c) result(rst) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Arguments Type Intent Optional Attributes Name class( coordinate_system ), intent(in), dimension(:) :: c An N-element array containing the coordinate frames for each\nof the N links of the linkage. Return Value type( dh_table ) The resulting Denavit-Hartenberg table.","tags":"","loc":"interface\\dh_table.html"},{"title":"binary_link – DYNAMICS","text":"public interface binary_link Contents Module Procedures bl_init Module Procedures private pure function bl_init(jtype, length, twist, offset, angle, mass, inertia, cg) result(rst) Initializes a new parallel_revolute_revolute_link instance. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in), optional :: jtype The proximal joint type. This value must be either &\nREVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, \nthis parameter defaults to REVOLUTE_JOINT. real(kind=real64), intent(in), optional :: length The link length. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: twist The link twist angle. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: offset The link offset. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: angle The joint angle offset. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: mass The mass of the link. If no value is specified, a value of 1 is\nused. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not specified, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the distal coordinate\nframe, expressed in the link coordinate frame. If not supplied,\nthe CG is set to (0, 0, 0) such that it is located at the center\nof the distal joint. Return Value type( binary_link ) The resulting binary_link object.","tags":"","loc":"interface\\binary_link.html"},{"title":"serial_linkage – DYNAMICS","text":"public interface serial_linkage Contents Module Procedures sl_init Module Procedures private function sl_init(lnks) result(rst) Initializes a new serial_linkage object. Arguments Type Intent Optional Attributes Name class( binary_link ), intent(in), dimension(:) :: lnks A collection of binary_link objects. The collection starts with\nthe first link and progresses to the end-effector in a \nsequential manner. Return Value type( serial_linkage ) The serial_linkage instance.","tags":"","loc":"interface\\serial_linkage.html"},{"title":"poincare_map – DYNAMICS","text":"public pure function poincare_map(x, y, z, pln, side) result(rst) Generates a Poincare map by determining the intersections of the\nsupplied trajectory with the specified plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The x-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: y The y-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: z The z-coordinates of the trajectory. class( plane ), intent(in), optional :: pln The plane to intersect. If not supplied, the x-y plane is \nutilized where z = 0. integer(kind=int32), intent(in), optional :: side An integer flag denoting which approach to use when computing\nthe section. The acceptable values are as follows. POINCARE_TWO_SIDED (Default): A two-sided Poincare section \nwill be computed. In this section, the algorithm does not care \nwhether the trajectory approaches the sectioning plane from the \nfront or the back of the plane (defined by the plane normal). It simply returns any intersection point. POINCARE_ONE_SIDED_FROM_FRONT: A one-sided Poincare section \nwill be computed where the algorithm only retains intersection \npoints where the trajectory approaches the sectioning plane from \nthe front (the side of the plane normal). POINCARE_ONE_SIDED_FROM_BACK: A one-sided Poincare section \nwill be computed where the algorithm only retains intersection \npoints where the trajectory approaches the sectioning plane from \nthe back (the side opposite the plane normal). Return Value real(kind=real64), allocatable, dimension(:,:) An N-by-3 matrix containing the x, y, and z coordinates of each\nof the N intersection points in the first, second, and third\ncolumns respectively. Contents","tags":"","loc":"proc\\poincare_map.html"},{"title":"inverse – DYNAMICS","text":"public pure elemental function inverse(q) result(rst) Computes the inverse of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The inverse of the supplied quaternion. Contents","tags":"","loc":"proc\\inverse.html"},{"title":"abs – DYNAMICS","text":"public interface abs Contents Module Procedures quat_abs Module Procedures private pure elemental function quat_abs(q) result(rst) Computes the magnitude of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The magnitude of the quaternion.","tags":"","loc":"interface\\abs.html"},{"title":"aimag – DYNAMICS","text":"public interface aimag Contents Module Procedures quat_aimag Module Procedures private pure function quat_aimag(q) result(rst) Returns the imaginary component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(3) The imaginary component as a vector.","tags":"","loc":"interface\\aimag.html"},{"title":"assignment(=) – DYNAMICS","text":"public interface assignment(=) Contents Module Procedures quat_assign quat_assign_vec4 Module Procedures private pure elemental subroutine quat_assign(x, y) Assigns a quaternion to another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. type( quaternion ), intent(in) :: y The source quaternion. private pure subroutine quat_assign_vec4(x, y) Assigns a 4-element vector to a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. real(kind=real64), intent(in), dimension(4) :: y The source vector.","tags":"","loc":"interface\\assignment(=)~2.html"},{"title":"conjg – DYNAMICS","text":"public interface conjg Contents Module Procedures quat_conjg Module Procedures private pure elemental function quat_conjg(q) result(rst) Computes the conjugate of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The conjugate of the quaternion.","tags":"","loc":"interface\\conjg.html"},{"title":"dot_product – DYNAMICS","text":"public interface dot_product Contents Module Procedures quat_dot_prd Module Procedures private pure elemental function quat_dot_prd(x, y) result(rst) Computes the dot product of two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value real(kind=real64) The dot product.","tags":"","loc":"interface\\dot_product.html"},{"title":"exp – DYNAMICS","text":"public interface exp Contents Module Procedures quat_exp Module Procedures private pure elemental function quat_exp(q) result(rst) Evaluates the exponential function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\exp.html"},{"title":"log – DYNAMICS","text":"public interface log Contents Module Procedures quat_log Module Procedures private pure elemental function quat_log(q) result(rst) Evalautes the natural logarithm function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\log.html"},{"title":"operator(*) – DYNAMICS","text":"public interface operator(*) Contents Module Procedures quat_scalar_mult scalar_quat_mult quat_multiply quat_vec3_mult Module Procedures private pure elemental function quat_scalar_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function scalar_quat_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The scalar. type( quaternion ), intent(in) :: y The quaternion. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_multiply(x, y) result(rst) Multiplies two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure function quat_vec3_mult(x, y) result(rst) Multiplies a quaternion with a 3-element vector. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in), dimension(3) :: y The vector. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(ASTERISK)~2.html"},{"title":"operator(**) – DYNAMICS","text":"public interface operator(**) Contents Module Procedures quat_pwr quat_int_pwr Module Procedures private pure elemental function quat_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. real(kind=real64), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_int_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. integer(kind=int32), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(ASTERISKASTERISK).html"},{"title":"operator(+) – DYNAMICS","text":"public interface operator(+) Contents Module Procedures quat_add Module Procedures private pure elemental function quat_add(x, y) result(rst) Adds two quaternions together. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(+).html"},{"title":"operator(-) – DYNAMICS","text":"public interface operator(-) Contents Module Procedures quat_subtract quat_negate Module Procedures private pure elemental function quat_subtract(x, y) result(rst) Subtracts two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_negate(x) result(rst) Negates a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(-).html"},{"title":"operator(/) – DYNAMICS","text":"public interface operator(/) Contents Module Procedures quat_scalar_div quat_divide Module Procedures private pure elemental function quat_scalar_div(x, y) result(rst) Divides a quaternion by a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_divide(x, y) result(rst) Divides a quaternion by another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(SLASH).html"},{"title":"quaternion – DYNAMICS","text":"public interface quaternion Contents Module Procedures quat_init_array quat_init_angle_axis quat_init_mtx Module Procedures private pure function quat_init_array(x) result(rst) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(4) :: x The array from which to initialize the quaternion stored in the\norder [w, x, y, z]. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_angle_axis(angle, axis) result(rst) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. real(kind=real64), intent(in), dimension(3) :: axis A 3-element vector defining the axis about which the rotation\noccurrs. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_mtx(r) result(rst) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(3, 3) :: r The rotation matrix. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\quaternion.html"},{"title":"real – DYNAMICS","text":"public interface real Contents Module Procedures quat_real Module Procedures private pure elemental function quat_real(q) result(rst) Returns the real component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The real component.","tags":"","loc":"interface\\real.html"},{"title":"initialize_rigid_body – DYNAMICS","text":"public pure subroutine initialize_rigid_body(bdy, m, inertia, cg) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name class( rigid_body ), intent(inout) :: bdy The rigid_body object. real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Contents","tags":"","loc":"proc\\initialize_rigid_body.html"},{"title":"rigid_body – DYNAMICS","text":"public interface rigid_body Contents Module Procedures rb_init Module Procedures private pure function rb_init(m, inertia, cg) result(rst) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Return Value type( rigid_body ) The rigid_body object.","tags":"","loc":"interface\\rigid_body.html"},{"title":"acceleration_transform – DYNAMICS","text":"public pure function acceleration_transform(alpha, omega, a, x) result(rst) Computes the acceleration transformation matrix relating the\nposition of a point expressed in a rotating and translating body\nrelative to its parent frame. The transformation matrix takes the following form. where, and, Given a vector describing the location on a moving body, , the matrix is used to report its acceleration . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha (3) The angular acceleration vector. real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: a (3) The translational acceleration vector describing the acceleration\nof the body in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. Contents","tags":"","loc":"proc\\acceleration_transform.html"},{"title":"rotate_x – DYNAMICS","text":"public pure function rotate_x(angle) result(rst) Constructs the rotation matrix describing a rotation about an\nx-axis such that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Contents","tags":"","loc":"proc\\rotate_x.html"},{"title":"rotate_y – DYNAMICS","text":"public pure function rotate_y(angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Contents","tags":"","loc":"proc\\rotate_y.html"},{"title":"rotate_z – DYNAMICS","text":"public pure function rotate_z(angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Contents","tags":"","loc":"proc\\rotate_z.html"},{"title":"velocity_transform – DYNAMICS","text":"public pure function velocity_transform(omega, v, x) result(rst) Computes the velocity transformation matrix relating the position\nof a point expressed in a rotating and translating body relative to\nits parent frame. The transformation matrix takes the following form. where, Given a vector describing the location on a moving body, , the matrix is used to report its velocity . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: v (3) The translation velocity vector describing the velocity of the\nbody in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. Contents","tags":"","loc":"proc\\velocity_transform.html"},{"title":"to_angle_axis – DYNAMICS","text":"public pure subroutine to_angle_axis(r, angle, axis) Extracts the equivalent rotation angle and axis of rotation given a\n3-by-3 rotation matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: r (3,3) The 3-by-3 rotation matrix. real(kind=real64), intent(out) :: angle The rotation angle. real(kind=real64), intent(out) :: axis (3) The axis of rotation. Contents","tags":"","loc":"proc\\to_angle_axis.html"},{"title":"rotate – DYNAMICS","text":"public interface rotate Contents Module Procedures rotate_general_1 rotate_general_2 Module Procedures private pure function rotate_general_1(i, j, k, Ip, Jp, Kp) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. real(kind=real64), intent(in) :: Ip (3) The parent coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: Jp (3) The parent coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: Kp (3) The parent coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. private pure function rotate_general_2(i, j, k) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. The parent coordinate frame is assumed to be as follows. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix.","tags":"","loc":"interface\\rotate.html"},{"title":"determine_local_stability – DYNAMICS","text":"public function determine_local_stability(a, ev, err) result(rst) Determines the nature of stability/unstability near the point at which\nthe dynamics matrix was computed. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a An N-by-N matrix containing the 'A' matrix, also known as the\ndynamics matrix. complex(kind=real64), intent(out), optional, dimension(:) :: ev An optional N-element array that, if supplied, will be filled with \nthe eigenvalues of the matrix A. class(errors), intent(inout), optional, target :: err An error handler object. Return Value integer(kind=int32) Describe the output constants Contents","tags":"","loc":"proc\\determine_local_stability.html"},{"title":"create_connectivity_matrix – DYNAMICS","text":"public function create_connectivity_matrix(gdof, e, nodes, err) result(rst) Creates a connectivity matrix for the element. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: gdof The number of global degrees of freedom. class( element ), intent(in) :: e The element. class( node ), intent(in), dimension(:) :: nodes The global node list. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. Contents","tags":"","loc":"proc\\create_connectivity_matrix.html"},{"title":"restore_constrained_values – DYNAMICS","text":"public function restore_constrained_values(gdof, x, err) result(rst) Restores the constrained degrees-of-freedom from the boundary conditions\napplied by apply_boundary_conditions. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The constrained vector. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector. Contents","tags":"","loc":"proc\\restore_constrained_values.html"},{"title":"shape_function_derivative – DYNAMICS","text":"public pure function shape_function_derivative(index, elem, s, i) result(rst) Computes the derivative of the shape function with respect to the natural\ncoordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. Contents","tags":"","loc":"proc\\shape_function_derivative.html"},{"title":"shape_function_second_derivative – DYNAMICS","text":"public pure function shape_function_second_derivative(index, elem, s, i) result(rst) Computes the second derivative of the shape function with respect to the\nnatural coordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. Contents","tags":"","loc":"proc\\shape_function_second_derivative.html"},{"title":"apply_displacement_constraint – DYNAMICS","text":"public subroutine apply_displacement_constraint(dof, val, k, f) Applies a displacement constraint to the specified degree of freedom. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: dof The global degree-of-freedom to which the constraint should be\napplied. real(kind=real64), intent(in) :: val The value of the displacement constraint. real(kind=real64), intent(inout), dimension(:,:) :: k The stiffness matrix to which the constraint should be applied. real(kind=real64), intent(inout), dimension(:) :: f The external force vector to which the constraint should be applied. Contents","tags":"","loc":"proc\\apply_displacement_constraint.html"},{"title":"apply_boundary_conditions – DYNAMICS","text":"public interface apply_boundary_conditions Contents Module Procedures apply_boundary_conditions_mtx apply_boundary_conditions_vec Module Procedures private function apply_boundary_conditions_mtx(gdof, x, err) result(rst) Applies boundary conditions to a matrix by removal of the appropriate\nrows and columns. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:,:) :: x The matrix to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The altered matrix. private function apply_boundary_conditions_vec(gdof, x, err) result(rst) Applies boundary conditions to a vector by removal of the appropriate\nitems. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The vector to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector.","tags":"","loc":"interface\\apply_boundary_conditions.html"},{"title":"constraint_equations – DYNAMICS","text":"interface public subroutine constraint_equations(xg, fg, xc, p, fc, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: xg An N-element array containing the N independent variable\nvalues for the N differential equation solution points. real(kind=real64), intent(in), dimension(:) :: fg An N-element array containing the N differential equation\nsolution points. real(kind=real64), intent(in), dimension(:) :: xc An M-element array containing the M independent variable\nvalues for the M constraint equations. real(kind=real64), intent(in), dimension(:) :: p An array containing the model parameters. real(kind=real64), intent(out), dimension(:) :: fc An M-element array where the values of the constraint \nequations should be written. class(*), intent(inout), optional :: args An optional argument that can be used to pass data in/out\nof this routine. Description An interface to a set of routines for defining constraint \nequations to the fitting process.","tags":"","loc":"interface\\constraint_equations.html"},{"title":"siso_model_fit_least_squares – DYNAMICS","text":"public interface siso_model_fit_least_squares Contents Module Procedures siso_model_fit_least_squares_1 siso_model_fit_least_squares_2 Module Procedures private subroutine siso_model_fit_least_squares_1(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector for the equations in fcn. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object. private subroutine siso_model_fit_least_squares_2(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:,:) :: ic An M-by-NEQN matrix of initial condition vectors for the NEQN \nequations in fcn, one set for each of the M sets of data in x. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object.","tags":"","loc":"interface\\siso_model_fit_least_squares.html"},{"title":"damping_from_fractional_overshoot – DYNAMICS","text":"public pure function damping_from_fractional_overshoot(x) result(rst) Employs the method of fractional overshoot to estimate the damping ratio\nfrom the response of a system to a step input. This method is useful\nfor cases where the damping ratio is between approximately 0.5 to 0.8.\nIn such range, the logarithmic decrement approach becomes less precise. The fractional overshoot method locates the amplitude of the first\npeak of oscillation ( ) and the settling amplitude ( ), and\nthe estimates the damping ratio as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The estimated damping ratio. Contents","tags":"","loc":"proc\\damping_from_fractional_overshoot.html"},{"title":"damping_from_log_decrement – DYNAMICS","text":"public pure elemental function damping_from_log_decrement(delta) result(rst) Computes the damping ratio from the logarithmic decrement .\nThe damping ratio is related to the logarithmic decrement by the \nfollowing relationship. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: delta The logarithmic decrement. Return Value real(kind=real64) The damping ratio. Contents","tags":"","loc":"proc\\damping_from_log_decrement.html"},{"title":"estimate_bandwidth – DYNAMICS","text":"public pure elemental function estimate_bandwidth(fn, zeta) result(rst) Estimates the bandwidth of the resonant mode of a vibratory system.\nThe bandwidth is the width of the range of frequencies for which the\nenergy is at least half its peak value and is computed as . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: fn The resonant frequency. The units are not important; however, \nthe units of the output will be the same as the units of this\nparameter. real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The bandwidth. Contents","tags":"","loc":"proc\\estimate_bandwidth.html"},{"title":"evaluate_step_response – DYNAMICS","text":"public pure elemental function evaluate_step_response(wn, zeta, xs, t) result(rst) Evaluates the response of an underdamped single-degree-of-freedom, \nlinear system to a step function of amplitude . The step function response of an underdamped linear SDOF system is given\nas follows. where, and Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio. real(kind=real64), intent(in) :: xs The amplitude of the step input. real(kind=real64), intent(in) :: t The point in time at which to evaluate the response (units = s). Return Value real(kind=real64) The step response. Contents","tags":"","loc":"proc\\evaluate_step_response.html"},{"title":"find_settling_amplitude – DYNAMICS","text":"public pure function find_settling_amplitude(x) result(rst) Uses fftpack Estimates the settling amplitude for a step response. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The settling amplitude of the step response. Contents","tags":"","loc":"proc\\find_settling_amplitude.html"},{"title":"logarithmic_decrement – DYNAMICS","text":"public pure elemental function logarithmic_decrement(x1, x2, n) result(rst) Computes the logarithmic decrement given the value of two successive\npeaks in the time history of the free vibratory response of the system.\nThe logarithmic decrement is calculated as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x1 The amplitude of the first peak. real(kind=real64), intent(in) :: x2 The amplitude of the second peak that occurs N periods after the\nfirst. integer(kind=int32), intent(in) :: n The number of periods of oscillation seperating the two peaks. Return Value real(kind=real64) The logarithmic decrement . Contents","tags":"","loc":"proc\\logarithmic_decrement.html"},{"title":"q_factor – DYNAMICS","text":"public pure elemental function q_factor(zeta) result(rst) Estimates the Q-factor for a vibratory system. The Q-factor is computed . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The Q-factor. Contents","tags":"","loc":"proc\\q_factor.html"},{"title":"rise_time – DYNAMICS","text":"public pure elemental function rise_time(wn, zeta) result(rst) Computes the rise time for an underdamped, second-order system. The\nrise time is the time it takes for the system response to go from 0%\nto 100% of its final value and is given by the following relationship. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency of the system, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio of the system. This value must be less than 1\nas this relationship is only valid for an underdamped system. Return Value real(kind=real64) The rise time, in units of seconds. Contents","tags":"","loc":"proc\\rise_time.html"},{"title":"find_free_response_properties – DYNAMICS","text":"public subroutine find_free_response_properties(t, x, delta, fn, x1, x2, t1, t2, s, n) Given a free-response time history, this routine attempts to find the \nlogarithmic decrement and resonant frequency of a vibratory system. The\nlogarithmic decrement is estimated by finding successive peaks by\nmeans of peak detection. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: t An N-element array containing the values in time real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the response sampled at the time points\ngiven in t. real(kind=real64), intent(out) :: delta The logarithmic decrement estimate. If sufficient peaks cannot be\nlocated, the routine returns NaN. real(kind=real64), intent(out) :: fn The damped resonant frequency in units of Hz, assuming that the\ntime values are in seconds. If the time units are not in seconds,\nthe units will be cycle/unit time with unit time being the units\nin which t is supplied. If sufficient peaks cannot be located, the \nroutine returns NaN. real(kind=real64), intent(out), optional :: x1 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the first peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: x2 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the second peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: t1 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the first peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(out), optional :: t2 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the second peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(in), optional :: s An optional input that, if provided, allows for control of the \nsensitivity of the peak detection algorithm. The default is 0.1%\nof the peak-peak amplitude of the signal. integer(kind=int32), intent(in), optional :: n An optional input that, if provided, determines the number of \nperiods to allow between peak selection for the logarithmic \ndecrement calculation. The default is 1. Contents","tags":"","loc":"proc\\find_free_response_properties.html"},{"title":"dynamics – DYNAMICS","text":"Uses dynamics_quaternions dynamics_kinematics dynamics_helper dynamics_system_id dynamics_frequency_response dynamics_vibrations dynamics_stability dynamics_controls dynamics_geometry dynamics_structural dynamics_linkage dynamics_rotation Contents None","tags":"","loc":"module\\dynamics.html"},{"title":"dynamics_controls – DYNAMICS","text":"Uses linalg dynamics_error_handling diffeq ieee_arithmetic iso_fortran_env lapack ferror nonlin_polynomials Contents Interfaces operator(*) ss_excitation state_space transfer_function Derived Types state_space transfer_function Functions lti_solve Interfaces public interface operator(*) private function tf_tf_mult(x, y) result(rst) Multiplies two transfer functions. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function poly_tf_mult(x, y) result(rst) Multiplies a polynomial and a transfer function to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_poly_mult(x, y) result(rst) Multiplies a transfer function and a polynomial to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class(polynomial), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_scalar_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. real(kind=real64), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function scalar_tf_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. interface public subroutine ss_excitation(t, u, args) A routine for computing the excitation vector for a state-space\nmodel. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The time value at which to compute the excitation. real(kind=real64), intent(out), dimension(:) :: u The excitation vector. class(*), intent(inout), optional :: args An optional argument used to pass objects in and out of the\nroutine. public interface state_space private pure function state_space_init(m, b, k, n_out) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: m The N-by-N mass matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: b The N-by-N damping matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: k The N-by-N stiffness matrix. integer(kind=int32), intent(in), optional :: n_out The number of outputs. The default is 1. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_scalar(m, b, k) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: m The mass. real(kind=real64), intent(in) :: b The damping. real(kind=real64), intent(in) :: k The stiffness. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_matrices(a, b, c, d) result(rst) Initializes the state space model. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix. real(kind=real64), intent(in), dimension(:,:) :: b The N-by-M input matrix. real(kind=real64), intent(in), dimension(:,:) :: c The P-by-N output matrix. real(kind=real64), intent(in), dimension(:,:) :: d The P-by-M feedthrough matrix. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid(kp, ki, kd, tau, a, b, c, d) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix for the plant. real(kind=real64), intent(in), dimension(size(a, 1), 1) :: b The N-by-1 input matrix for the plant. real(kind=real64), intent(in), dimension(1, size(a, 1)) :: c The 1-by-N output matrix for the plant. real(kind=real64), intent(in), dimension(1, 1) :: d The 1-by-1 feedthrough matrix for the plant. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid_plant(kp, ki, kd, tau, plant) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . class( state_space ), intent(in) :: plant The plant model. Return Value type( state_space ) The resulting [[state_space]] object. public interface transfer_function private function init_tf_array(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . real(kind=real64), intent(in), dimension(:) :: x The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . Return Value type( transfer_function ) The resulting [[transfer_function]]. private function init_tf_poly(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: y The numerator polynomial in . class(polynomial), intent(in) :: x The denominator polynomial in . Return Value type( transfer_function ) The resulting [[transfer_function]]. Derived Types type, public :: state_space Defines a state-space representation of a dynamic system. This\nimplementation takes the form: Read more… Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:,:) :: A The N-by-N dynamics matrix, where N is the number of state\nvariables. real(kind=real64), public, allocatable, dimension(:,:) :: B The N-by-M input matrix, where M is the number of inputs. real(kind=real64), public, allocatable, dimension(:,:) :: C The P-by-N output matrix, where P is the number of outputs. real(kind=real64), public, allocatable, dimension(:,:) :: D The P-by-M feedthrough matrix. Constructor private\n\n pure\n function state_space_init (m, b, k, n_out) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. private\n\n pure\n function state_space_init_scalar (m, b, k) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. private\n\n pure\n function state_space_init_matrices (a, b, c, d) Initializes the state space model. private\n\n pure\n function state_space_init_pid (kp, ki, kd, tau, a, b, c, d) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. private\n\n pure\n function state_space_init_pid_plant (kp, ki, kd, tau, plant) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Type-Bound Procedures procedure\n , public\n :: evaluate_derivatives =>\n ss_eval_deriv Function procedure\n , public\n :: evaluate_output =>\n ss_eval_output Function procedure\n , public\n :: poles =>\n ss_poles Function generic,\n public\n :: transfer_function =>\n ss_transfer_fcn, ss_transfer_fcn_omega, ss_transfer_fcn_array, ss_transfer_fcn_omega_array procedure\n , public\n :: zeros =>\n ss_zeros Function type, public :: transfer_function Defines a transfer function for a continuous system of the form . Components Type Visibility Attributes Name Initial type(polynomial), public :: X The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . type(polynomial), public :: Y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . Constructor private\n\n \n function init_tf_array (y, x) Initializes a new transfer function. private\n\n \n function init_tf_poly (y, x) Initializes a new transfer function. Type-Bound Procedures generic,\n public\n :: evaluate =>\n tf_eval_omega, tf_eval_s procedure\n , public\n :: poles =>\n tf_poles Function procedure\n , public\n :: to_ccf_state_space =>\n tf_to_ccf_statespace Function procedure\n , public\n :: to_ocf_state_space =>\n tf_to_ocf_statespace Function procedure\n , public\n :: zeros =>\n tf_zeros Function Functions public function lti_solve (mdl, u, t, ic, solver, args, err) result(rst) Solves the LTI system given by the specified state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in), target :: mdl The state_space model to solve. procedure( ss_excitation ), intent(in), pointer :: u The routine used to compute the excitation vector. real(kind=real64), intent(in), dimension(:) :: t The time points at which to compute the solution. The array must\nhave at least 2 values; however, more may be specified. If only\n2 values are specified, the integrator will compute the solution at\nthose points, but it will also return any intermediate integration\nsteps that may be required. However, if more than 2 points are\ngiven, the integrator will return the solution values only at the\nspecified time points. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector. This array must be the same size as\nthe number of state variables. class(ode_integrator), intent(in), optional, target :: solver The ODE solver to utilize. If not specified, the default solver\nis a 4th/5th order Runge-Kutta integrator. class(*), intent(inout), optional :: args An optional container for arguments to pass to the excitation\nroutine. class(errors), intent(inout), optional, target :: err An error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The solution. The time points at which the solution was evaluated\nare stored in the first column and the output(s) are stored in the\nremaining column(s).","tags":"","loc":"module\\dynamics_controls.html"},{"title":"dynamics_error_handling – DYNAMICS","text":"Uses iso_fortran_env fstats_errors ferror diffeq_errors nonlin_error_handling Contents Variables DYN_ARRAY_SIZE_ERROR DYN_CONSTRAINT_ERROR DYN_CONVERGENCE_ERROR DYN_INDEX_OUT_OF_RANGE DYN_INVALID_INPUT_ERROR DYN_MATRIX_SIZE_ERROR DYN_MEMORY_ERROR DYN_NONMONOTONIC_ARRAY_ERROR DYN_NULL_POINTER_ERROR DYN_TOLERANCE_TOO_SMALL_ERROR DYN_TOO_FEW_ITERATIONS_ERROR DYN_UNDERDEFINED_PROBLEM_EROR DYN_ZERO_VALUED_FREQUENCY_ERROR Subroutines report_array_index_out_of_bounds_error report_array_size_error report_constraint_count_error report_convergence_error report_generic_counting_error report_matrix_size_error report_matrix_size_mismatch_error report_memory_error report_nonmonotonic_array_error report_nonsquare_mass_matrix_error report_nonsquare_matrix_error report_nonsquare_stiffness_matrix_error report_null_forcing_routine_error report_null_solver_routine_error report_overconstraint_error report_zero_difference_error report_zero_valued_frequency_error Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: DYN_ARRAY_SIZE_ERROR = 100105 Defines an error for an improperly sized array. integer(kind=int32), public, parameter :: DYN_CONSTRAINT_ERROR = 100102 Defines a constraint-related error. integer(kind=int32), public, parameter :: DYN_CONVERGENCE_ERROR = NL_CONVERGENCE_ERROR Defines an error related to convergence issues. integer(kind=int32), public, parameter :: DYN_INDEX_OUT_OF_RANGE = 100103 Defines an index out of range error. integer(kind=int32), public, parameter :: DYN_INVALID_INPUT_ERROR = DIFFEQ_INVALID_INPUT_ERROR Defines an error associated with an invalid input. integer(kind=int32), public, parameter :: DYN_MATRIX_SIZE_ERROR = 100100 Defines an error associated with an incorrectly sized matrix. integer(kind=int32), public, parameter :: DYN_MEMORY_ERROR = DIFFEQ_MEMORY_ALLOCATION_ERROR Defines an error associated with memory allocations. integer(kind=int32), public, parameter :: DYN_NONMONOTONIC_ARRAY_ERROR = 100104 Defines an error related to an array being nonmonotonic. integer(kind=int32), public, parameter :: DYN_NULL_POINTER_ERROR = DIFFEQ_NULL_POINTER_ERROR Defines an error associated with a null pointer. integer(kind=int32), public, parameter :: DYN_TOLERANCE_TOO_SMALL_ERROR = FS_TOLERANCE_TOO_SMALL_ERROR Defines an error related to the request of a too small tolerance \nvalue. integer(kind=int32), public, parameter :: DYN_TOO_FEW_ITERATIONS_ERROR = FS_TOO_FEW_ITERATION_ERROR Defines an error when too few iterations were allowed. integer(kind=int32), public, parameter :: DYN_UNDERDEFINED_PROBLEM_EROR = FS_UNDERDEFINED_PROBLEM_ERROR Defines an error for an underdefined problem. integer(kind=int32), public, parameter :: DYN_ZERO_VALUED_FREQUENCY_ERROR = 100101 Defines an error associated with a zero-valued frequency. Subroutines public subroutine report_array_index_out_of_bounds_error (name, var, ind, sz, err) Reports an array index-out-of-bounds error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The offending index. integer(kind=int32), intent(in) :: sz The array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_array_size_error (name, var, expected, actual, err) Reports an array size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expected The expected array size. integer(kind=int32), intent(in) :: actual The actual array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_constraint_count_error (name, expected, actual, err) Reports an error associated with an incorrect number of constraints. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: expected The expected number of constraints. integer(kind=int32), intent(in) :: actual The actual number of constraints. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_convergence_error (name, niter, resid, err) Reports a convergence error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: niter The actual number of iterations taken. real(kind=real64), intent(in) :: resid The current residual estimate. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_generic_counting_error (name, str1, val, str2, flag, err) A generic error reporting routine. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: str1 The first string. integer(kind=int32), intent(in) :: val The integer value. character(len=*), intent(in) :: str2 The second string. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_matrix_size_error (name, var, expect_rows, expect_cols, actual_rows, actual_cols, err) Reports a matrix size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expect_rows The expected number of rows. integer(kind=int32), intent(in) :: expect_cols The expected number of columns. integer(kind=int32), intent(in) :: actual_rows The actual number of rows. integer(kind=int32), intent(in) :: actual_cols The actual number of columns. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_matrix_size_mismatch_error (name, mtx1, mtx2, m1, n1, m2, n2, err) Reports a mismatch in matrix sizes. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: mtx1 The name of the first matrix. character(len=*), intent(in) :: mtx2 The name of the second matrix. integer(kind=int32), intent(in) :: m1 The number of rows in the first matrix. integer(kind=int32), intent(in) :: n1 The number of columns in the first matrix. integer(kind=int32), intent(in) :: m2 The number of rows in the second matrix. integer(kind=int32), intent(in) :: n2 The number of columns in the second matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_memory_error (name, flag, err) Reports a memory allocation error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: flag The flag returned from the allocate statement. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonmonotonic_array_error (name, var, ind, err) Reports a nonmonotonic array error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The index of the occurrence of nonmonotonicity. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonsquare_mass_matrix_error (name, m, n, err) Reports an error relating to a non-square mass matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the mass matrix. integer(kind=int32), intent(in) :: n The number of columns found in the mass matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonsquare_matrix_error (name, var, m, n, err) Reports an error relating to a non-square matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: m The number of rows found in the matrix. integer(kind=int32), intent(in) :: n The number of columns found in the matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonsquare_stiffness_matrix_error (name, m, n, err) Reports an error relating to a non-square stiffness matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the stiffness matrix. integer(kind=int32), intent(in) :: n The number of columns found in the stiffness matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_null_forcing_routine_error (name, err) Reports a null forcing routine pointer error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_null_solver_routine_error (name, err) Reports a null solver routine error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_overconstraint_error (name, err) Reports an overconstraint error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_zero_difference_error (name, var1, val1, var2, val2, flag, err) Reports a zero-difference between two variables where a non-zero\ndifference was expected. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var1 The name of the first variable. real(kind=real64), intent(in) :: val1 The value of the first variable. character(len=*), intent(in) :: var2 The name of the second variable. real(kind=real64), intent(in) :: val2 The value of the second variable. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_zero_valued_frequency_error (name, index, err) Reports an error associated with a zero-valued frequency value. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: index The array index at which the zero-valued frequency was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution.","tags":"","loc":"module\\dynamics_error_handling.html"},{"title":"dynamics_frequency_response – DYNAMICS","text":"Uses dynamics_error_handling diffeq iso_fortran_env ferror fstats spectrum Contents Variables FRF_ACCELERANCE_MODEL FRF_RECEPTANCE_MODEL Interfaces evaluate_accelerance_frf_model evaluate_receptance_frf_model frequency_response frequency_sweep harmonic_ode modal_excite ode_excite Derived Types frf mimo_frf Functions chirp compute_modal_damping fit_frf Subroutines modal_response normalize_mode_shapes Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: FRF_ACCELERANCE_MODEL = 1 Defines an accelerance frequency response model. integer(kind=int32), public, parameter :: FRF_RECEPTANCE_MODEL = 2 Defines a receptance frequency response model. Interfaces public interface evaluate_accelerance_frf_model private pure function evaluate_accelerance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_accelerance_frf_model_array(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function. public interface evaluate_receptance_frf_model private pure function evaluate_receptance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_receptance_frf_model_array(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function. public interface frequency_response Computes the frequency response functions for a system of ODE's. private function frf_modal_prop_damp(mass, stiff, alpha, beta, freq, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . real(kind=real64), intent(in), dimension(:) :: freq An M-element array of frequency values at which to evaluate the\nfrequency response functions, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function frf_modal_prop_damp_2(mass, stiff, alpha, beta, nfreq, freq1, freq2, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency, in units of rad/s. real(kind=real64), intent(in) :: freq2 The ending frequency, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function siso_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency response of a single-input, single-output (SISO)\nsystem. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the excitation signal. real(kind=real64), intent(in), dimension(:) :: y An N-element array containing the response signal. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size. Return Value type( frf ) The resulting frequency response function. private function mimo_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency responses of a multiple-input, multiple-output\n(MIMO) system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x An N-by-P array containing the P inputs to the system. real(kind=real64), intent(in), dimension(:,:) :: y An N-by-M array containing the M outputs from the system. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y do not have the same number\n of rows. Return Value type( mimo_frf ) The resulting frequency response functions. public interface frequency_sweep private function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, points, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the frequency points at which the \nsolution should be computed. Notice, whatever units are utilized\nfor this array are also the units of the excitation_frequency\nproperty in @p sys. It is recommended that the units be set to \nHz. Additionally, this array cannot contain any zero-valued \nelements as the ODE solution time for each frequency is \ndetermined by the period of oscillation and number of cycles. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 20. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 200. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. Notice, there must be at least 2 points per cycle for the\nanalysis to be effective. The algorithm utilizes a discrete \nFourier transform to determine the phase and amplitude, and in \norder to satisfy Nyquist conditions, the value must be at least \n2. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses. private function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, ntransient, points, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency. It is recommended that the units be set\nto Hz. real(kind=real64), intent(in) :: freq2 The ending frequency. It is recommended that the units be set to\nHz. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 20. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 200. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. Notice, there must be at least 2 points per cycle for the\nanalysis to be effective. The algorithm utilizes a discrete \nFourier transform to determine the phase and amplitude, and in \norder to satisfy Nyquist conditions, the value must be at least \n2. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses. interface public subroutine harmonic_ode(freq, t, x, dxdt, args) Defines a system of ODE's exposed to harmonic excitation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. real(kind=real64), intent(in) :: t The current time step value. real(kind=real64), intent(in), dimension(:) :: x The value of the solution estimate at time t. real(kind=real64), intent(out), dimension(:) :: dxdt The derivatives as computed by this routine. class(*), intent(inout), optional :: args An optional argument allowing the passing of data in/out of\nthis routine. interface public subroutine modal_excite(freq, frc, args) Defines the interface to a routine for defining the forcing\nfunction for a modal frequency analysis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. When used as a part of a frequency\nresponse calculation, this value will have the same units as\nthe frequency values provided to the frequency response\nroutine. complex(kind=real64), intent(out), dimension(:) :: frc An N-element array where the forcing function should be\nwritten. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. interface public function ode_excite(t) result(rst) Defines the interface for a ODE excitation function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate\nthe excitation function. Return Value real(kind=real64) The result. Derived Types type, public :: frf A container for a frequency response function, or series of frequency\nresponse functions. Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:) :: responses An N-by-M matrix containing the M frequency response functions\nevaluated at each of the N frequency points. type, public :: mimo_frf A container for the frequency responses of a system of multiple \ninputs and multiple outputs (MIMO). Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:,:) :: responses An N-by-M-by-P array containing the frequency response functions\nfor each of the M outputs corresponding to each of the P inputs. Functions public pure elemental function chirp (t, amp, span, f1Hz, f2Hz) result(rst) Evaluates a linear chirp function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate the \nchirp. real(kind=real64), intent(in) :: amp The amplitude. real(kind=real64), intent(in) :: span The duration of the time it takes to sweep from the start \nfrequency to the end frequency. real(kind=real64), intent(in) :: f1Hz The lower excitation frequency, in Hz. real(kind=real64), intent(in) :: f2Hz The upper excitation frequency, in Hz. Return Value real(kind=real64) The value of the function at t. public pure elemental function compute_modal_damping (lambda, alpha, beta) result(rst) Computes the modal damping factors given the\nproportional damping terms and where , , and is the eigenvalue of the system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: lambda The square of the modal frequency - the eigen value. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . Return Value real(kind=real64) The modal damping parameter. public function fit_frf (mt, n, freq, rsp, maxp, minp, init, stats, alpha, controls, settings, info, err) result(rst) Fits an experimentally obtained frequency response by model for either a\nreceptance model: Read more… Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: mt The excitation method. The options are as follows. Read more… integer(kind=int32), intent(in) :: n The model order (# of resonant modes). real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the excitation frequency values in \nunits of rad/s. complex(kind=real64), intent(in), dimension(:) :: rsp An M-element array containing the frequency response to fit. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional 3*N-element array that can be used as upper limits on \nthe parameter values. If no upper limit is requested for a particular\nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional 3*N-element array that can be used as lower limits on \nthe parameter values. If no lower limit is requested for a particalar\nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: init An optional 3 N-element array that, if supplied, provides an initial\nguess for each of the 3 N model parameters for the iterative solver.\nIf supplied, this array replaces the peak finding algorithm for\nestimating an initial guess. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional 3*N-element array that, if supplied, will be used to\nreturn statistics about the fit for each model parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence intervals.\nThe default value is 0.05 such that a 95% confidence interval is \ncalculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. Read more… Return Value real(kind=real64), allocatable, dimension(:) An array containing the model parameters stored as . Subroutines public subroutine modal_response (mass, stiff, freqs, modeshapes, err) Computes the modal frequencies and modes shapes for \nmulti-degree-of-freedom system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must\nbe symmetric. real(kind=real64), intent(out), allocatable, dimension(:) :: freqs An allocatable N-element array where the modal frequencies will\nbe returned in ascending order with units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional, allocatable N-by-N matrix where the N mode shapes\nfor the system will be returned. The mode shapes are stored in\ncolumns. class(errors), intent(inout), optional, target :: err public subroutine normalize_mode_shapes (x) Normalizes mode shape vectors such that the largest magnitude\nvalue in the vector is one. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), dimension(:,:) :: x The matrix of mode shape vectors with one vector per column.","tags":"","loc":"module\\dynamics_frequency_response.html"},{"title":"dynamics_geometry – DYNAMICS","text":"Uses dynamics_helper ieee_arithmetic iso_fortran_env lapack fstats Contents Interfaces assignment(=) is_parallel line matmul plane plucker_line Derived Types line plane plucker_line Functions is_point_on_line is_point_on_plane line_common_normal line_from_point_and_vector nearest_point_on_line plane_normal point_plane_projection point_to_line_distance point_to_plane_distance vector_plane_projection Subroutines do_lines_intersect Interfaces public interface assignment(=) private pure elemental subroutine plane_assign(x, y) Assigns a plane to another. Arguments Type Intent Optional Attributes Name type( plane ), intent(out) :: x The resulting plane. type( plane ), intent(in) :: y The source plane private pure elemental subroutine line_assign(x, y) Assigns a line to another. Arguments Type Intent Optional Attributes Name type( line ), intent(out) :: x The resulting line. type( line ), intent(in) :: y The source line private pure elemental subroutine pl_assign(x, y) Assigns a plucker_line to another. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( plucker_line ), intent(in) :: y The source plucker_line. private pure elemental subroutine pl_assign_line(x, y) Assigns a line to a plucker_line. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( line ), intent(in) :: y The source line. public interface is_parallel private pure function is_parallel_vectors(x, y, tol) result(rst) Tests to see if two vectors are parallel. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the vectors are parallel; else, false. private pure function is_parallel_lines(x, y, tol) result(rst) Tests to see if two lines are parallel. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: x The first line. class( line ), intent(in) :: y The second line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the lines are parallel; else, false. private pure function is_parallel_planes(x, y, tol) result(rst) Tests to see if two planes are parallel. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: x The first plane. class( plane ), intent(in) :: y The second plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the planes are parallel; else, false. public interface line private pure function line_from_2pts(pt1, pt2) result(rst) Constructs a line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. This point will act as the initial point\nalong the line such that in the\nequation of the line . real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( line ) The resulting line. private pure function line_from_2_planes(p1, p2) result(rst) Constructs a line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function line_from_many_points(pts) result(rst) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts An N-by-3 matrix where N is at least 2, but typically much\nlarger. Return Value type( line ) The resulting line. public interface matmul private pure function pl_matmul(x, y) result(rst) Overloads the matmul routine to allow for multiplication of the\nPlücker line coordinate vector with a matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x The N-by-6 matrix. type( plucker_line ), intent(in) :: y The plucker_line object. Return Value real(kind=real64), allocatable, dimension(:) The resulting N-element array. public interface plane private pure function plane_from_3pts(pt1, pt2, pt3) result(rst) Constructs a plane from 3 points. The 3 points must not be colinear. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. real(kind=real64), intent(in) :: pt3 (3) The third point. Return Value type( plane ) The resulting plane. private pure function plane_from_point_and_normal(pt, nrm) result(rst) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point that lies on the plane. real(kind=real64), intent(in) :: nrm (3) The normal unit vector. Return Value type( plane ) The resulting plane. private pure function plane_from_many_points(pts) result(rst) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts The N-by-3 matrix containing the N points to fit. N must be\nat least 3, but is typically much larger. Return Value type( plane ) The resulting plane. public interface plucker_line private pure function pl_from_2pts(pt1, pt2) result(rst) Constructs a new plucker_line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( plucker_line ) The resulting line. private pure function pl_from_line(ln) result(rst) Constructs a new plucker_line from a line object. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln The line. Return Value type( plucker_line ) The equivalent plucker_line. private pure function pl_from_2_planes(p1, p2) result(rst) Constructs a new plucker_line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( plucker_line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function pl_from_array(x, nrm) result(rst) Constructs a new plucker_line from the supplied array. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (6) A 6-element array containing the Plücker coordinates. logical, intent(in), optional :: nrm An optional input that specifies if the first three coordinates\n(the unit vector) should be normalized (true), or left as-is\n(false). The default is true such that the vector is normalized. Return Value type( plucker_line ) The resulting line. Derived Types type, public :: line Defines the parametric form of a line . Components Type Visibility Attributes Name Initial real(kind=real64), public :: r0 (3) The coordinates of the initial point . real(kind=real64), public :: v (3) The vector defining the orientation of the line. Constructor private\n\n pure\n function line_from_2pts (pt1, pt2) Constructs a line from two points. private\n\n pure\n function line_from_2_planes (p1, p2) Constructs a line from the intersection of two planes. private\n\n pure\n function line_from_many_points (pts) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Type-Bound Procedures procedure\n , public\n :: evaluate =>\n line_eval Function type, public :: plane Defines a plane as . Components Type Visibility Attributes Name Initial real(kind=real64), public :: a The x-component of the plane normal vector. real(kind=real64), public :: b The y-component of the plane normal vector. real(kind=real64), public :: c The z-component of the plane normal vector. real(kind=real64), public :: d The offset from the origin. Constructor private\n\n pure\n function plane_from_3pts (pt1, pt2, pt3) Constructs a plane from 3 points. The 3 points must not be colinear. private\n\n pure\n function plane_from_point_and_normal (pt, nrm) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. private\n\n pure\n function plane_from_many_points (pts) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Type-Bound Procedures procedure\n , public\n :: flip_normal =>\n plane_flip_normal Subroutine type, public :: plucker_line Defines a line in 3D Euclidean space using Plücker coordinates. Components Type Visibility Attributes Name Initial real(kind=real64), public :: v (6) The 6-element array containing the Plücker coordinates. The\nfirst 3 elements contain the unit vector and the last 3 elements\ncontain the moment vector. Constructor private\n\n pure\n function pl_from_2pts (pt1, pt2) Constructs a new plucker_line from two points. private\n\n pure\n function pl_from_line (ln) Constructs a new plucker_line from a line object. private\n\n pure\n function pl_from_2_planes (p1, p2) Constructs a new plucker_line from the intersection of two planes. private\n\n pure\n function pl_from_array (x, nrm) Constructs a new plucker_line from the supplied array. Type-Bound Procedures procedure\n , public\n :: m =>\n pl_m Function procedure\n , public\n :: to_array =>\n pl_to_array Function procedure\n , public\n :: u =>\n pl_u Function Functions public pure function is_point_on_line (pt, ln, tol) result(rst) Tests to see if a point lies on a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the line; else, false. public pure function is_point_on_plane (pt, pln, tol) result(rst) Tests to see if a point lies on a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the plane; else, false. public pure function line_common_normal (ln1, ln2) result(rst) Returns the common normal line between two lines pointing from ln1 to\nln2. In the event that the two lines are parallel within the \nspecified tolerance, there exist an infinite number of common \nnormals; therefore, a line will be chosen that runs from ln1 to ln2\nwith the point at t = 0 coincident with the point at t = 0 on ln1. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. Return Value type( line ) The common normal line. The distance along this line between\nt = 0 and t = 1 defines the length of the common normal \nconnecting ln1 to ln2. In the event that ln1 and ln2 intersect,\nthe length of this line is zero. public pure function line_from_point_and_vector (pt, x, nx) result(rst) Constructs a new line from a point (defines the point where t = 0)\nand a direction vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point at which t = 0 on the line. real(kind=real64), intent(in) :: x (3) The direction vector defining the orientation of the line. logical, intent(in), optional :: nx An optional parameter that defines if x should be normalized to\na unit vector (true), or left as-is (false). The default is\ntrue such that x is normalized to a unit vector. Return Value type( line ) The resulting line. public pure function nearest_point_on_line (pt, ln) result(rst) Gets the line parameter for the point on the line nearest the \nspecified point. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The line parameteric variable defining the location of\nthe point nearest along the line. public pure function plane_normal (pln) result(rst) Returns the normal vector of a plane. Arguments Type Intent Optional Attributes Name type( plane ), intent(in) :: pln The plane. Return Value real(kind=real64), (3) The normal vector. public pure function point_plane_projection (pt, pln) result(rst) Projects a point onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane onto which to project the point. Return Value real(kind=real64), (3) The projected point. public pure function point_to_line_distance (pt, ln) result(rst) Computes the shortest distance between a point and a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The shortest distance between the point and line. public pure function point_to_plane_distance (pt, pln) result(rst) Computes the shortest distance between a point and a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. Return Value real(kind=real64) The shortest distance between the point and plane. public pure function vector_plane_projection (x, pln) result(rst) Projects a vector onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector to project. class( plane ), intent(in) :: pln The plane onto which to project the vector. Return Value real(kind=real64), (3) The projected vector. Subroutines public pure subroutine do_lines_intersect (ln1, ln2, intersect, t1, t2, tol) Tests to see if two lines intersect. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. logical, intent(out) :: intersect True if the two lines intersect within the specified tolerance;\nelse, false if they do not intersect. real(kind=real64), intent(out), optional :: t1 The parametric value associate with ln1 defining the intersection\npoint. real(kind=real64), intent(out), optional :: t2 The parametric value associate with ln2 defining the intersection\npoint. real(kind=real64), intent(in), optional :: tol The intersection tolerance. If not supplied, the default value\nis 10x machine epsilon.","tags":"","loc":"module\\dynamics_geometry.html"},{"title":"dynamics_helper – DYNAMICS","text":"Uses iso_fortran_env Contents Functions cross_product scalar_projection to_skew_symmetric vector_angle vector_projection Functions public pure function cross_product (x, y) result(rst) Computes the cross-product of a vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The left-hand-side argument. real(kind=real64), intent(in) :: y (3) The right-hand-side argument Return Value real(kind=real64), (3) The resulting vector. public pure function scalar_projection (x, y) result(rst) Computes the projection of vector x onto vector y. The scalar projection\nis defined such that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64) The scalar projection of x onto y. public pure function to_skew_symmetric (x) result(rst) Converts a 3-element vector to a 3-by-3 skew-symmetric matrix. A \nskew-symmetric matrix is defined as follows. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector. Return Value real(kind=real64), (3,3) The resulting skew-symmetric matrix. public pure function vector_angle (x, y) result(rst) Computes the angle between two vectors. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. Return Value real(kind=real64) The angle, in radians. public pure function vector_projection (x, y) result(rst) Computes the vector pojection of vector x onto vector y. The vector\nprojection is defined such that Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64), (3) The vector projection of x onto y.","tags":"","loc":"module\\dynamics_helper.html"},{"title":"dynamics_kinematics – DYNAMICS","text":"Uses dynamics_quaternions dynamics_helper dynamics_error_handling dynamics_geometry iso_fortran_env ferror nonlin Contents Variables PRISMATIC_JOINT REVOLUTE_JOINT Interfaces coordinate_system dh_forward_kinematics dh_jacobian dh_parameter_set dh_table Derived Types coordinate_system dh_parameter_set dh_table Functions dh_matrix dh_rotate_x dh_rotate_z dh_translate_x dh_translate_z identity_4 jacobian_generating_vector solve_inverse_kinematics Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: PRISMATIC_JOINT = 1 Defines a prismatic joint. integer(kind=int32), public, parameter :: REVOLUTE_JOINT = 0 Defines a revolute joint. Interfaces public interface coordinate_system private pure function define_link_csys(xim1, zim1, zi, rim1, ri) result(rst) Defines the DH coordinate system for the specified link. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: xim1 (3) The x-axis of the previous link. real(kind=real64), intent(in) :: zim1 (3) The z-axis of the previous link. This is also the axis of the\nproximal joint of the current link. real(kind=real64), intent(in) :: zi (3) The axis of the distal joint of the current link. real(kind=real64), intent(in) :: rim1 (3) The location of the proximal joint's center or home position. real(kind=real64), intent(in) :: ri (3) The location of the distal joint's center or home position. Return Value type( coordinate_system ) The resulting coordinate system. private pure function define_csys(i, j, k, o) result(rst) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The x-axis unit vector. real(kind=real64), intent(in) :: j (3) The y-axis unit vector. real(kind=real64), intent(in) :: k (3) The x-axis unit vector. real(kind=real64), intent(in), optional :: o (3) The location of the coordinate system within a reference \ncoordinate system. If not supplied, a value of (0, 0, 0) will\nbe used. Return Value type( coordinate_system ) The new coordinate_system object. public interface dh_forward_kinematics private pure function dh_forward_kinematics_2(T1, T2) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_3(T1, T2, T3) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_4(T1, T2, T3, T4) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_5(T1, T2, T3, T4, T5) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_6(T1, T2, T3, T4, T5, T6) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_7(T1, T2, T3, T4, T5, T6, T7) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_8(T1, T2, T3, T4, T5, T6, T7, T8) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. real(kind=real64), intent(in) :: T8 (4,4) The transformation matrix for the eigth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_array(alpha, a, theta, d) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. The first entry must\nbe from the first link nearest ground. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_params(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_parameter_set ), intent(in), dimension(:) :: x The list of DH parameters. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_table(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_table ), intent(in) :: x The DH table. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. public interface dh_jacobian private function dh_build_jacobian(alpha, a, theta, d, jtypes) result(rst) Builds the Jacobian matrix for a linkage given the Denavit-Hartenberg\nparameters. The first entry in each array must be from the first link\nnearest ground. The Jacobian matrix relates the joint velocities to the end-effector velocity by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. integer(kind=int32), intent(in), dimension(size(alpha)) :: jtypes The types of each joint. Must be either REVOLUTE_JOINT or\nPRISMATIC_JOINT. The code defaults to REVOLUTE_JOINT. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-N Jacobian matrix where N is the number of joint\nvariables (i.e. the length of the input arrays). public interface dh_parameter_set private pure function dps_init(length, twist, offset, angle) result(rst) Constructs a new dh_parameter_set object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: length The link length. real(kind=real64), intent(in) :: twist The link twist. real(kind=real64), intent(in) :: offset The link offset. real(kind=real64), intent(in) :: angle The joint angle. Return Value type( dh_parameter_set ) The new dh_parameter_set object. public interface dh_table private pure function dh_table_init(c) result(rst) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Arguments Type Intent Optional Attributes Name class( coordinate_system ), intent(in), dimension(:) :: c An N-element array containing the coordinate frames for each\nof the N links of the linkage. Return Value type( dh_table ) The resulting Denavit-Hartenberg table. Derived Types type, public :: coordinate_system Defines a 3D Cartesian coordinate system. Components Type Visibility Attributes Name Initial real(kind=real64), public :: i (3) The unit vector along the coordinate system's x-axis. real(kind=real64), public :: j (3) The unit vector along the coordinate system's y-axis. real(kind=real64), public :: k (3) The unit vector along the coordinate system's z-axis. real(kind=real64), public :: origin (3) The location of the origin of the coordinate system in the parent\ncoordinate system. Constructor private\n\n pure\n function define_link_csys (xim1, zim1, zi, rim1, ri) Defines the DH coordinate system for the specified link. private\n\n pure\n function define_csys (i, j, k, o) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. type, public :: dh_parameter_set Describes a set of Denavit-Hartenberg parameters for a single joint. Components Type Visibility Attributes Name Initial real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. Constructor private\n\n pure\n function dps_init (length, twist, offset, angle) Constructs a new dh_parameter_set object. type, public :: dh_table Describes a Denavit-Hartenberg table. Components Type Visibility Attributes Name Initial type( dh_parameter_set ), public, allocatable, dimension(:) :: parameters A collection of DH parameters for each joint in the linkage. Constructor private\n\n pure\n function dh_table_init (c) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Functions public pure function dh_matrix (alpha, a, theta, d) result(rst) Computes the Denavit-Hartenberg transformation matrix for the \nspecified DH parameters. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The link twist angle, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in) :: a The link length as measured along the link's x-axis. real(kind=real64), intent(in) :: theta The joint angle, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in) :: d The joint offset distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. public pure function dh_rotate_x (alpha) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. public pure function dh_rotate_z (theta) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: theta The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. public pure function dh_translate_x (a) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a The translation. Return Value real(kind=real64), (4,4) The matrix. public pure function dh_translate_z (d) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d The translation. Return Value real(kind=real64), (4,4) The matrix. public pure function identity_4 () result(rst) Computes a 4-by-4 identity matrix. Arguments None Return Value real(kind=real64), (4,4) The resulting identity matrix. public pure function jacobian_generating_vector (d, k, R, jtype) result(rst) Computes a single Jacobian generating vector given the position vector\nof the link origin, , and the joint axis unit vector, . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d (3) The position vector of the end-effector, , relative to the\nlink coordinate frame given in the base coordinate frame. An easy\nway to compute this vector is to extract the first 3 elements of the\n4th column of the transformation matrix: . real(kind=real64), intent(in) :: k (3) The unit vector defining the joint axis, , given in the\nbase coordinate frame. This vector can be computed most easily by\nusing the transformation matrix: and\nthen computing . real(kind=real64), intent(in) :: R (3,3) The rotation matrix defining the orientation of the link coordinate\nframe relative to the base coordinate frame. integer(kind=int32), intent(in) :: jtype The joint type. Must be either REVOLUTE_JOINT or PRISMATIC_JOINT.\nIf incorrectly specified, the code defaults to a REVOLUTE_JOINT type. Return Value real(kind=real64), (6) The resulting 6-element Jacobian generating vector. public function solve_inverse_kinematics (mdl, qo, constraints, df, slvr, ib, jfcn, qmax, qmin, args, err) result(rst) Solves the inverse kinematics problem for a linkage. An iterative\nsolution procedure is utilized. Arguments Type Intent Optional Attributes Name procedure(vecfcn), intent(in), pointer :: mdl A routine used to compute the forward kinematics for the linkage\ngiven the current joint variable estimates. real(kind=real64), intent(in), dimension(:) :: qo An M-element array containing an initial estimate of the M joint\nvariables. real(kind=real64), intent(in), target, dimension(:) :: constraints An N-element array containing the target values (constraints) for\neach of the N kinematic equations in the model. N must be at \nleast equal to M (the number of joint variables). real(kind=real64), intent(out), optional, target, dimension(:) :: df An optional N-element array that, if supplied, can be used to \nretrieve the residuals of each of the N kinematic equations. class(constrained_equation_solver), intent(inout), optional, target :: slvr An optional solver that can be used in place of the default\nLevenberg-Marquardt solver. type(iteration_behavior), intent(out), optional :: ib An optional output that can be used to gather information on the\nsolver. procedure(jacobianfcn), intent(in), optional, pointer :: jfcn A routine that can be used to provide the Jacobian matrix for\nthe linkage. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmax An optional set of upper limits on each of the joint variables.\nIf not provided, the default is the output of the 'huge' \nintrinsic function. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmin An optional set of lower limits on each of the joint variables.\nIf not provided, the default is the negative of the output of \nthe 'huge' intrinsic function. class(*), intent(inout), optional, target :: args An optional argument that can be used to communicate with mdl. class(errors), intent(inout), optional, target :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Return Value real(kind=real64), allocatable, dimension(:) An M-element array containing the computed joint variables.","tags":"","loc":"module\\dynamics_kinematics.html"},{"title":"dynamics_linkage – DYNAMICS","text":"Uses dynamics_quaternions dynamics_kinematics dynamics_helper dynamics_geometry iso_fortran_env ferror collections dynamics_rigid_bodies Contents Interfaces binary_link serial_linkage Derived Types binary_link serial_linkage Interfaces public interface binary_link private pure function bl_init(jtype, length, twist, offset, angle, mass, inertia, cg) result(rst) Initializes a new parallel_revolute_revolute_link instance. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in), optional :: jtype The proximal joint type. This value must be either &\nREVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, \nthis parameter defaults to REVOLUTE_JOINT. real(kind=real64), intent(in), optional :: length The link length. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: twist The link twist angle. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: offset The link offset. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: angle The joint angle offset. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: mass The mass of the link. If no value is specified, a value of 1 is\nused. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not specified, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the distal coordinate\nframe, expressed in the link coordinate frame. If not supplied,\nthe CG is set to (0, 0, 0) such that it is located at the center\nof the distal joint. Return Value type( binary_link ) The resulting binary_link object. public interface serial_linkage private function sl_init(lnks) result(rst) Initializes a new serial_linkage object. Arguments Type Intent Optional Attributes Name class( binary_link ), intent(in), dimension(:) :: lnks A collection of binary_link objects. The collection starts with\nthe first link and progresses to the end-effector in a \nsequential manner. Return Value type( serial_linkage ) The serial_linkage instance. Derived Types type, public, extends( rigid_body ) :: binary_link Defines a link consisting of only two joints. The coordinate system\nof this link is situated at the distal joint with it's z-axis \ncoincident with the axis of the joint. The link utilizes a\nDenavit-Hartenberg convention in order to express its geometry. Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: joint_type The proximal joint type. This value must be either \nREVOLUTE_JOINT or PRISMATIC_JOINT. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the fixed distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. real(kind=real64), public :: mass The mass of the body. Constructor private\n\n pure\n function bl_init (jtype, length, twist, offset, angle, mass, inertia, cg) Initializes a new parallel_revolute_revolute_link instance. type, public :: serial_linkage Defines a serial linkage. Constructor private\n\n \n function sl_init (lnks) Initializes a new serial_linkage object. Type-Bound Procedures procedure\n , public\n :: forward_kinematics =>\n sl_forward_kinematics Function procedure\n , public\n :: get_link =>\n sl_get_link Function procedure\n , public\n :: get_link_count =>\n sl_get_link_count Function procedure\n , public\n :: inverse_kinematics =>\n sl_inverse_kinematics_1 Function procedure\n , public\n :: jacobian =>\n sl_jacobian Function","tags":"","loc":"module\\dynamics_linkage.html"},{"title":"dynamics_maps – DYNAMICS","text":"Uses iso_fortran_env dynamics_geometry Contents Variables POINCARE_ONE_SIDED_FROM_BACK POINCARE_ONE_SIDED_FROM_FRONT POINCARE_TWO_SIDED Functions poincare_map Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: POINCARE_ONE_SIDED_FROM_BACK = 2 A one-sided Poincare section will be computed where the algorithm\nonly retains intersection points where the trajectory approaches\nthe sectioning plane from the back (the side opposite the plane \nnormal). integer(kind=int32), public, parameter :: POINCARE_ONE_SIDED_FROM_FRONT = 1 A one-sided Poincare section will be computed where the algorithm\nonly retains intersection points where the trajectory approaches\nthe sectioning plane from the front (the side of the plane normal). integer(kind=int32), public, parameter :: POINCARE_TWO_SIDED = 0 A two-sided Poincare section will be computed. In this section, the\nalgorithm does not care whether the trajectory approaches the \nsectioning plane from the front or the back of the plane (defined\nby the plane normal). It simply returns any intersection point. Functions public pure function poincare_map (x, y, z, pln, side) result(rst) Generates a Poincare map by determining the intersections of the\nsupplied trajectory with the specified plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The x-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: y The y-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: z The z-coordinates of the trajectory. class( plane ), intent(in), optional :: pln The plane to intersect. If not supplied, the x-y plane is \nutilized where z = 0. integer(kind=int32), intent(in), optional :: side An integer flag denoting which approach to use when computing\nthe section. The acceptable values are as follows. Read more… Return Value real(kind=real64), allocatable, dimension(:,:) An N-by-3 matrix containing the x, y, and z coordinates of each\nof the N intersection points in the first, second, and third\ncolumns respectively.","tags":"","loc":"module\\dynamics_maps.html"},{"title":"dynamics_quaternions – DYNAMICS","text":"Uses iso_fortran_env Contents Interfaces abs aimag assignment(=) conjg dot_product exp log operator(*) operator(**) operator(+) operator(-) operator(/) quaternion real Derived Types quaternion Functions inverse Interfaces public interface abs private pure elemental function quat_abs(q) result(rst) Computes the magnitude of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The magnitude of the quaternion. public interface aimag private pure function quat_aimag(q) result(rst) Returns the imaginary component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(3) The imaginary component as a vector. public interface assignment(=) private pure elemental subroutine quat_assign(x, y) Assigns a quaternion to another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. type( quaternion ), intent(in) :: y The source quaternion. private pure subroutine quat_assign_vec4(x, y) Assigns a 4-element vector to a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. real(kind=real64), intent(in), dimension(4) :: y The source vector. public interface conjg private pure elemental function quat_conjg(q) result(rst) Computes the conjugate of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The conjugate of the quaternion. public interface dot_product private pure elemental function quat_dot_prd(x, y) result(rst) Computes the dot product of two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value real(kind=real64) The dot product. public interface exp private pure elemental function quat_exp(q) result(rst) Evaluates the exponential function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion. public interface log private pure elemental function quat_log(q) result(rst) Evalautes the natural logarithm function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion. public interface operator(*) private pure elemental function quat_scalar_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function scalar_quat_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The scalar. type( quaternion ), intent(in) :: y The quaternion. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_multiply(x, y) result(rst) Multiplies two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure function quat_vec3_mult(x, y) result(rst) Multiplies a quaternion with a 3-element vector. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in), dimension(3) :: y The vector. Return Value type( quaternion ) The resulting quaternion. public interface operator(**) private pure elemental function quat_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. real(kind=real64), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_int_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. integer(kind=int32), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion. public interface operator(+) private pure elemental function quat_add(x, y) result(rst) Adds two quaternions together. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. public interface operator(-) private pure elemental function quat_subtract(x, y) result(rst) Subtracts two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_negate(x) result(rst) Negates a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. Return Value type( quaternion ) The resulting quaternion. public interface operator(/) private pure elemental function quat_scalar_div(x, y) result(rst) Divides a quaternion by a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_divide(x, y) result(rst) Divides a quaternion by another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. public interface quaternion private pure function quat_init_array(x) result(rst) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(4) :: x The array from which to initialize the quaternion stored in the\norder [w, x, y, z]. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_angle_axis(angle, axis) result(rst) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. real(kind=real64), intent(in), dimension(3) :: axis A 3-element vector defining the axis about which the rotation\noccurrs. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_mtx(r) result(rst) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(3, 3) :: r The rotation matrix. Return Value type( quaternion ) The resulting quaternion. public interface real private pure elemental function quat_real(q) result(rst) Returns the real component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The real component. Derived Types type, public :: quaternion Defines a quaternion of the form: Components Type Visibility Attributes Name Initial real(kind=real64), public :: w The real component of the quaternion. real(kind=real64), public :: x The first element in the imaginary component of the quaternion. real(kind=real64), public :: y The second element in the imaginary component of the quaternion. real(kind=real64), public :: z The third element in the imaginary component of the quaternion. Constructor private\n\n pure\n function quat_init_array (x) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. private\n\n pure\n function quat_init_angle_axis (angle, axis) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. private\n\n pure\n function quat_init_mtx (r) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Type-Bound Procedures procedure\n , public\n :: normalize =>\n quat_normalize Subroutine procedure\n , public\n :: to_angle_axis =>\n quat_to_angle_axis Subroutine procedure\n , public\n :: to_array =>\n quat_to_vec4 Function procedure\n , public\n :: to_matrix =>\n quat_to_matrix Function procedure\n , public\n :: to_roll_pitch_yaw =>\n quat_to_rpy Subroutine Functions public pure elemental function inverse (q) result(rst) Computes the inverse of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The inverse of the supplied quaternion.","tags":"","loc":"module\\dynamics_quaternions.html"},{"title":"dynamics_rigid_bodies – DYNAMICS","text":"Uses iso_fortran_env Contents Interfaces rigid_body Derived Types rigid_body Subroutines initialize_rigid_body Interfaces public interface rigid_body private pure function rb_init(m, inertia, cg) result(rst) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Return Value type( rigid_body ) The rigid_body object. Derived Types type, public :: rigid_body Defines a rigid body. Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: mass The mass of the body. Constructor private\n\n pure\n function rb_init (m, inertia, cg) Initializes a rigid_body object. Subroutines public pure subroutine initialize_rigid_body (bdy, m, inertia, cg) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name class( rigid_body ), intent(inout) :: bdy The rigid_body object. real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0).","tags":"","loc":"module\\dynamics_rigid_bodies.html"},{"title":"dynamics_rotation – DYNAMICS","text":"Uses iso_fortran_env dynamics_helper Contents Interfaces rotate Functions acceleration_transform rotate_x rotate_y rotate_z velocity_transform Subroutines to_angle_axis Interfaces public interface rotate private pure function rotate_general_1(i, j, k, Ip, Jp, Kp) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. real(kind=real64), intent(in) :: Ip (3) The parent coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: Jp (3) The parent coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: Kp (3) The parent coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. private pure function rotate_general_2(i, j, k) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. The parent coordinate frame is assumed to be as follows. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Functions public pure function acceleration_transform (alpha, omega, a, x) result(rst) Computes the acceleration transformation matrix relating the\nposition of a point expressed in a rotating and translating body\nrelative to its parent frame. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha (3) The angular acceleration vector. real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: a (3) The translational acceleration vector describing the acceleration\nof the body in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. public pure function rotate_x (angle) result(rst) Constructs the rotation matrix describing a rotation about an\nx-axis such that . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. public pure function rotate_y (angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. public pure function rotate_z (angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. public pure function velocity_transform (omega, v, x) result(rst) Computes the velocity transformation matrix relating the position\nof a point expressed in a rotating and translating body relative to\nits parent frame. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: v (3) The translation velocity vector describing the velocity of the\nbody in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. Subroutines public pure subroutine to_angle_axis (r, angle, axis) Extracts the equivalent rotation angle and axis of rotation given a\n3-by-3 rotation matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: r (3,3) The 3-by-3 rotation matrix. real(kind=real64), intent(out) :: angle The rotation angle. real(kind=real64), intent(out) :: axis (3) The axis of rotation.","tags":"","loc":"module\\dynamics_rotation.html"},{"title":"dynamics_stability – DYNAMICS","text":"Uses iso_fortran_env linalg ferror dynamics_error_handling Contents Variables HYPERBOLIC_FIXED_POINT_SADDLE HYPERBOLIC_FIXED_POINT_SINK HYPERBOLIC_FIXED_POINT_SOURCE NONHYPERBOLIC_FIXED_POINT_CENTER NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE NONHYPERBOLIC_FIXED_POINT_UNSTABLE Functions determine_local_stability Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: HYPERBOLIC_FIXED_POINT_SADDLE = 102 Describes a hyperbolic fixed point where all of the eigenvalues of\nthe dynamics matrix have a nonzero real part but one or more of the\neigenvalues has a positive-valued real part. integer(kind=int32), public, parameter :: HYPERBOLIC_FIXED_POINT_SINK = 100 Describes a hyperbolic fixed point where all of the eigenvalues of\nthe dynamics matrix have a nonzero real part and all real parts are\nnegative-valued. This point is considered stable. integer(kind=int32), public, parameter :: HYPERBOLIC_FIXED_POINT_SOURCE = 101 Describes a hyperbolic fixed point where all of the eigenvalues of\nthe dynamics matrix have a nonzero real part and the real\npart is positive-valued for each. This point is considered unstable. integer(kind=int32), public, parameter :: NONHYPERBOLIC_FIXED_POINT_CENTER = 105 Describes a nonhyperbolic fixed point where all of the eigenvalues\nof the dynamics matrix are purely imaginary and nonzero. This point\nis considered stable. integer(kind=int32), public, parameter :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE = 104 Describes a nonhyperbolic fixed point where some of the eigenvalues \nof the dynamics matrix have negative real parts and the remaining\neigenvalues all have zero-valued real parts. integer(kind=int32), public, parameter :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE = 103 Describes a nonhyperbolic fixed point where one or more of the \neigenvalues of the dynamics matrix have a positive-valued real part. Functions public function determine_local_stability (a, ev, err) result(rst) Determines the nature of stability/unstability near the point at which\nthe dynamics matrix was computed. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a An N-by-N matrix containing the 'A' matrix, also known as the\ndynamics matrix. complex(kind=real64), intent(out), optional, dimension(:) :: ev An optional N-element array that, if supplied, will be filled with \nthe eigenvalues of the matrix A. class(errors), intent(inout), optional, target :: err An error handler object. Return Value integer(kind=int32) Describe the output constants","tags":"","loc":"module\\dynamics_stability.html"},{"title":"dynamics_structural – DYNAMICS","text":"Uses linalg dynamics_error_handling iso_fortran_env ferror dynamics_rotation Contents Variables DYN_FOUR_POINT_INTEGRATION_RULE DYN_ONE_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE Interfaces apply_boundary_conditions Derived Types beam_element_2d beam_element_3d element line_element material node point Functions create_connectivity_matrix restore_constrained_values shape_function_derivative shape_function_second_derivative Subroutines apply_displacement_constraint Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: DYN_FOUR_POINT_INTEGRATION_RULE = 4 Defines a four-point integration rule. integer(kind=int32), public, parameter :: DYN_ONE_POINT_INTEGRATION_RULE = 1 Defines a single-point integration rule. integer(kind=int32), public, parameter :: DYN_THREE_POINT_INTEGRATION_RULE = 3 Defines a three-point integration rule. integer(kind=int32), public, parameter :: DYN_TWO_POINT_INTEGRATION_RULE = 2 Defines a two-point integration rule. Interfaces public interface apply_boundary_conditions private function apply_boundary_conditions_mtx(gdof, x, err) result(rst) Applies boundary conditions to a matrix by removal of the appropriate\nrows and columns. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:,:) :: x The matrix to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The altered matrix. private function apply_boundary_conditions_vec(gdof, x, err) result(rst) Applies boundary conditions to a vector by removal of the appropriate\nitems. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The vector to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector. Derived Types type, public, extends( line_element ) :: beam_element_2d Defines a two-dimensional Bernoulli-Euler beam element. Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. real(kind=real64), public :: moment_of_inertia The beam moment of inertia (second moment of area). type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). Type-Bound Procedures procedure\n , public\n :: constitutive_matrix =>\n b2d_constitutive_matrix Function procedure\n , public\n :: evaluate_shape_function =>\n b2d_shape_function Function procedure\n , public\n :: external_force_vector =>\n le_ext_force_vector Function procedure\n , public\n :: get_dimensionality =>\n b2d_dimensionality Function procedure\n , public\n :: get_dof_per_node =>\n b2d_dof_per_node Function procedure\n , public\n :: get_node =>\n b2d_get_node Function procedure\n , public\n :: get_node_count =>\n b2d_get_node_count Function procedure\n , public\n :: get_terminal_nodes =>\n b2d_terminal_nodes Subroutine procedure\n , public\n :: jacobian =>\n b2d_jacobian Function procedure\n , public\n :: length =>\n le_length Function procedure\n , public\n :: mass_matrix =>\n b2d_mass_matrix Function procedure\n , public\n :: rotation_matrix =>\n b2d_rotation_matrix Function procedure\n , public\n :: shape_function_matrix =>\n b2d_shape_function_matrix_2d Function procedure\n , public\n :: stiffness_matrix =>\n b2d_stiffness_matrix Function procedure\n , public\n :: strain_displacement_matrix =>\n b2d_strain_disp_matrix_2d Function type, public, extends( line_element ) :: beam_element_3d Defines a three-dimensional Bernoulli-Euler beam element. Components Type Visibility Attributes Name Initial real(kind=real64), public :: Ixx The beam moment of inertia about the element x-axis. real(kind=real64), public :: Iyy The beam moment of inertia about the element y-axis. real(kind=real64), public :: Izz The beam moment of inertia about the element z-axis. real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). type( point ), public :: orientation_point A point used to determine the orientation of the beam in 3D\nspace. The orientation point is measured relative to the first\nnode in the element. Specifically, the element z axis is assumed\nto be defined by the location of this point relative to the\nlocation of node 1. Type-Bound Procedures procedure\n , public\n :: constitutive_matrix =>\n b3d_constitutive_matrix Function procedure\n , public\n :: evaluate_shape_function =>\n b3d_shape_function Function procedure\n , public\n :: external_force_vector =>\n le_ext_force_vector Function procedure\n , public\n :: get_dimensionality =>\n b3d_dimensionality Function procedure\n , public\n :: get_dof_per_node =>\n b3d_dof_per_node Function procedure\n , public\n :: get_node =>\n b3d_get_node Function procedure\n , public\n :: get_node_count =>\n b3d_get_node_count Function procedure\n , public\n :: get_terminal_nodes =>\n b3d_terminal_nodes Subroutine procedure\n , public\n :: jacobian =>\n b3d_jacobian Function procedure\n , public\n :: length =>\n le_length Function procedure\n , public\n :: mass_matrix =>\n b3d_mass_matrix Function procedure\n , public\n :: rotation_matrix =>\n b3d_rotation_matrix Function procedure\n , public\n :: shape_function_matrix =>\n b3d_shape_function_matrix_3d Function procedure\n , public\n :: stiffness_matrix =>\n b3d_stiffness_matrix Function procedure\n , public\n :: strain_displacement_matrix =>\n b3d_strain_disp_matrix_3d Function type, public :: element Defines an element. Components Type Visibility Attributes Name Initial type( material ), public :: material The material. Type-Bound Procedures procedure\n(element_const_matrix_function) , public\n, pass :: constitutive_matrix procedure\n(element_shape_function) , public\n, pass :: evaluate_shape_function procedure\n , public\n :: external_force_vector =>\n e_ext_force_vector Function procedure\n(element_query) , public\n, pass :: get_dimensionality procedure\n(element_query) , public\n, pass :: get_dof_per_node procedure\n(element_get_node) , public\n, pass :: get_node procedure\n(element_query) , public\n, pass :: get_node_count procedure\n(element_matrix_function) , public\n, pass :: jacobian procedure\n , public\n :: mass_matrix =>\n e_mass_matrix Function procedure\n(element_matrix_function) , public\n, pass :: shape_function_matrix procedure\n , public\n :: stiffness_matrix =>\n e_stiffness_matrix Function procedure\n(element_matrix_function) , public\n, pass :: strain_displacement_matrix type, public, extends( element ) :: line_element Defines a line element type. Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. Type-Bound Procedures procedure\n(element_const_matrix_function) , public\n, pass :: constitutive_matrix procedure\n(element_shape_function) , public\n, pass :: evaluate_shape_function procedure\n , public\n :: external_force_vector =>\n le_ext_force_vector Function procedure\n(element_query) , public\n, pass :: get_dimensionality procedure\n(element_query) , public\n, pass :: get_dof_per_node procedure\n(element_get_node) , public\n, pass :: get_node procedure\n(element_query) , public\n, pass :: get_node_count procedure\n(line_element_get_terminal) , public\n, pass :: get_terminal_nodes procedure\n(element_matrix_function) , public\n, pass :: jacobian procedure\n , public\n :: length =>\n le_length Function procedure\n , public\n :: mass_matrix =>\n le_mass_matrix Function procedure\n(line_element_const_matrix_function) , public\n, pass :: rotation_matrix procedure\n(element_matrix_function) , public\n, pass :: shape_function_matrix procedure\n , public\n :: stiffness_matrix =>\n le_stiffness_matrix Function procedure\n(element_matrix_function) , public\n, pass :: strain_displacement_matrix type, public :: material Defines a linear-elastic-isotropic material. Components Type Visibility Attributes Name Initial real(kind=real64), public :: density The density of the material. real(kind=real64), public :: modulus The modulus of elasticity of the material. real(kind=real64), public :: poissons_ratio The Poisson's ratio of the material. type, public, extends( point ) :: node Defines a node. Components Type Visibility Attributes Name Initial integer(kind=int32), public :: dof The number of degrees of freeedom associated with this node. integer(kind=int32), public :: index The global index of the node. real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate. type, public :: point Defines a point in 3D, Cartesian space. Components Type Visibility Attributes Name Initial real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate. Functions public function create_connectivity_matrix (gdof, e, nodes, err) result(rst) Creates a connectivity matrix for the element. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: gdof The number of global degrees of freedom. class( element ), intent(in) :: e The element. class( node ), intent(in), dimension(:) :: nodes The global node list. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. public function restore_constrained_values (gdof, x, err) result(rst) Restores the constrained degrees-of-freedom from the boundary conditions\napplied by apply_boundary_conditions. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The constrained vector. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector. public pure function shape_function_derivative (index, elem, s, i) result(rst) Computes the derivative of the shape function with respect to the natural\ncoordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. public pure function shape_function_second_derivative (index, elem, s, i) result(rst) Computes the second derivative of the shape function with respect to the\nnatural coordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. Subroutines public subroutine apply_displacement_constraint (dof, val, k, f) Applies a displacement constraint to the specified degree of freedom. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: dof The global degree-of-freedom to which the constraint should be\napplied. real(kind=real64), intent(in) :: val The value of the displacement constraint. real(kind=real64), intent(inout), dimension(:,:) :: k The stiffness matrix to which the constraint should be applied. real(kind=real64), intent(inout), dimension(:) :: f The external force vector to which the constraint should be applied.","tags":"","loc":"module\\dynamics_structural.html"},{"title":"dynamics_system_id – DYNAMICS","text":"Uses dynamics_error_handling diffeq iso_fortran_env ferror fstats Contents Interfaces constraint_equations siso_model_fit_least_squares Derived Types dynamic_system_measurement model_information Interfaces interface public subroutine constraint_equations(xg, fg, xc, p, fc, args) An interface to a set of routines for defining constraint \nequations to the fitting process. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: xg An N-element array containing the N independent variable\nvalues for the N differential equation solution points. real(kind=real64), intent(in), dimension(:) :: fg An N-element array containing the N differential equation\nsolution points. real(kind=real64), intent(in), dimension(:) :: xc An M-element array containing the M independent variable\nvalues for the M constraint equations. real(kind=real64), intent(in), dimension(:) :: p An array containing the model parameters. real(kind=real64), intent(out), dimension(:) :: fc An M-element array where the values of the constraint \nequations should be written. class(*), intent(inout), optional :: args An optional argument that can be used to pass data in/out\nof this routine. public interface siso_model_fit_least_squares private subroutine siso_model_fit_least_squares_1(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector for the equations in fcn. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object. private subroutine siso_model_fit_least_squares_2(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:,:) :: ic An M-by-NEQN matrix of initial condition vectors for the NEQN \nequations in fcn, one set for each of the M sets of data in x. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object. Derived Types type, public :: dynamic_system_measurement A container of a single measurement data set. Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: input The input data. real(kind=real64), public, allocatable, dimension(:) :: output The output data. real(kind=real64), public, allocatable, dimension(:) :: t The time points at which the measurements were taken. type, public :: model_information A container for model information. Components Type Visibility Attributes Name Initial class(base_interpolator), public, pointer :: excitation An interpolation object allowing sampling of the excitation \nfunction. real(kind=real64), public, allocatable, dimension(:) :: model An array containing the model parameters. class(*), public, pointer :: user_info Information the user has passed along.","tags":"","loc":"module\\dynamics_system_id.html"},{"title":"dynamics_vibrations – DYNAMICS","text":"Uses ieee_arithmetic iso_fortran_env peaks Contents Functions damping_from_fractional_overshoot damping_from_log_decrement estimate_bandwidth evaluate_step_response find_settling_amplitude logarithmic_decrement q_factor rise_time Subroutines find_free_response_properties Functions public pure function damping_from_fractional_overshoot (x) result(rst) Employs the method of fractional overshoot to estimate the damping ratio\nfrom the response of a system to a step input. This method is useful\nfor cases where the damping ratio is between approximately 0.5 to 0.8.\nIn such range, the logarithmic decrement approach becomes less precise. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The estimated damping ratio. public pure elemental function damping_from_log_decrement (delta) result(rst) Computes the damping ratio from the logarithmic decrement .\nThe damping ratio is related to the logarithmic decrement by the \nfollowing relationship. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: delta The logarithmic decrement. Return Value real(kind=real64) The damping ratio. public pure elemental function estimate_bandwidth (fn, zeta) result(rst) Estimates the bandwidth of the resonant mode of a vibratory system.\nThe bandwidth is the width of the range of frequencies for which the\nenergy is at least half its peak value and is computed as . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: fn The resonant frequency. The units are not important; however, \nthe units of the output will be the same as the units of this\nparameter. real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The bandwidth. public pure elemental function evaluate_step_response (wn, zeta, xs, t) result(rst) Evaluates the response of an underdamped single-degree-of-freedom, \nlinear system to a step function of amplitude . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio. real(kind=real64), intent(in) :: xs The amplitude of the step input. real(kind=real64), intent(in) :: t The point in time at which to evaluate the response (units = s). Return Value real(kind=real64) The step response. public pure function find_settling_amplitude (x) result(rst) Estimates the settling amplitude for a step response. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The settling amplitude of the step response. public pure elemental function logarithmic_decrement (x1, x2, n) result(rst) Computes the logarithmic decrement given the value of two successive\npeaks in the time history of the free vibratory response of the system.\nThe logarithmic decrement is calculated as follows. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x1 The amplitude of the first peak. real(kind=real64), intent(in) :: x2 The amplitude of the second peak that occurs N periods after the\nfirst. integer(kind=int32), intent(in) :: n The number of periods of oscillation seperating the two peaks. Return Value real(kind=real64) The logarithmic decrement . public pure elemental function q_factor (zeta) result(rst) Estimates the Q-factor for a vibratory system. The Q-factor is computed . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The Q-factor. public pure elemental function rise_time (wn, zeta) result(rst) Computes the rise time for an underdamped, second-order system. The\nrise time is the time it takes for the system response to go from 0%\nto 100% of its final value and is given by the following relationship. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency of the system, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio of the system. This value must be less than 1\nas this relationship is only valid for an underdamped system. Return Value real(kind=real64) The rise time, in units of seconds. Subroutines public subroutine find_free_response_properties (t, x, delta, fn, x1, x2, t1, t2, s, n) Given a free-response time history, this routine attempts to find the \nlogarithmic decrement and resonant frequency of a vibratory system. The\nlogarithmic decrement is estimated by finding successive peaks by\nmeans of peak detection. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: t An N-element array containing the values in time real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the response sampled at the time points\ngiven in t. real(kind=real64), intent(out) :: delta The logarithmic decrement estimate. If sufficient peaks cannot be\nlocated, the routine returns NaN. real(kind=real64), intent(out) :: fn The damped resonant frequency in units of Hz, assuming that the\ntime values are in seconds. If the time units are not in seconds,\nthe units will be cycle/unit time with unit time being the units\nin which t is supplied. If sufficient peaks cannot be located, the \nroutine returns NaN. real(kind=real64), intent(out), optional :: x1 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the first peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: x2 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the second peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: t1 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the first peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(out), optional :: t2 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the second peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(in), optional :: s An optional input that, if provided, allows for control of the \nsensitivity of the peak detection algorithm. The default is 0.1%\nof the peak-peak amplitude of the signal. integer(kind=int32), intent(in), optional :: n An optional input that, if provided, determines the number of \nperiods to allow between peak selection for the logarithmic \ndecrement calculation. The default is 1.","tags":"","loc":"module\\dynamics_vibrations.html"},{"title":"dynamics.f90 – DYNAMICS","text":"Contents Modules dynamics Source Code dynamics.f90 Source Code module dynamics use dynamics_frequency_response use dynamics_rotation use dynamics_structural use dynamics_kinematics use dynamics_vibrations use dynamics_helper use dynamics_stability use dynamics_controls use dynamics_system_id use dynamics_linkage use dynamics_geometry use dynamics_quaternions implicit none private ! DYNAMICS_FREQUENCY_RESPONSE public :: ode_excite public :: modal_excite public :: harmonic_ode public :: frf public :: mimo_frf public :: chirp public :: frequency_response public :: frequency_sweep public :: compute_modal_damping public :: modal_response public :: normalize_mode_shapes public :: evaluate_accelerance_frf_model public :: evaluate_receptance_frf_model public :: fit_frf public :: FRF_ACCELERANCE_MODEL public :: FRF_RECEPTANCE_MODEL public :: regression_statistics public :: iteration_controls public :: lm_solver_options public :: convergence_info ! DYNAMICS_ROTATION public :: rotate_x public :: rotate_y public :: rotate_z public :: rotate public :: acceleration_transform public :: velocity_transform public :: to_angle_axis ! DYNAMICS_STRUCTURAL public :: DYN_ONE_POINT_INTEGRATION_RULE public :: DYN_TWO_POINT_INTEGRATION_RULE public :: DYN_THREE_POINT_INTEGRATION_RULE public :: DYN_FOUR_POINT_INTEGRATION_RULE public :: node public :: material public :: element public :: line_element public :: beam_element_2d public :: shape_function_derivative public :: shape_function_second_derivative public :: create_connectivity_matrix public :: apply_boundary_conditions public :: apply_displacement_constraint public :: restore_constrained_values public :: point public :: beam_element_3d ! DYNAMICS_KINEMATICS public :: identity_4 public :: dh_rotate_x public :: dh_rotate_z public :: dh_translate_x public :: dh_translate_z public :: dh_matrix public :: dh_forward_kinematics public :: solve_inverse_kinematics public :: vecfcn public :: jacobianfcn public :: least_squares_solver public :: iteration_behavior public :: vecfcn_helper public :: jacobian_generating_vector public :: dh_jacobian public :: REVOLUTE_JOINT public :: PRISMATIC_JOINT public :: coordinate_system public :: dh_parameter_set public :: dh_table ! DYNAMICS_VIBRATIONS public :: q_factor public :: estimate_bandwidth public :: logarithmic_decrement public :: damping_from_log_decrement public :: find_free_response_properties public :: rise_time public :: find_settling_amplitude public :: damping_from_fractional_overshoot public :: evaluate_step_response ! DYNAMICS_HELPER public :: cross_product public :: to_skew_symmetric public :: vector_angle public :: scalar_projection public :: vector_projection ! DYNAMICS_STABILITY public :: HYPERBOLIC_FIXED_POINT_SINK public :: HYPERBOLIC_FIXED_POINT_SOURCE public :: HYPERBOLIC_FIXED_POINT_SADDLE public :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE public :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE public :: NONHYPERBOLIC_FIXED_POINT_CENTER public :: determine_local_stability ! DYNAMICS_CONTROLS public :: polynomial public :: state_space public :: transfer_function public :: lti_solve public :: ss_excitation public :: ode_integrator ! DYNAMICS_SYSTEM_ID public :: dynamic_system_measurement public :: model_information public :: siso_model_fit_least_squares public :: constraint_equations ! DYNAMICS_LINKAGE public :: binary_link public :: serial_linkage ! DYNAMICS_GEOMETRY public :: plane public :: plane_normal public :: line public :: plucker_line public :: is_parallel public :: is_point_on_plane public :: is_point_on_line public :: nearest_point_on_line public :: point_to_line_distance public :: point_to_plane_distance public :: vector_plane_projection public :: point_plane_projection public :: matmul public :: line_from_point_and_vector public :: line_common_normal public :: do_lines_intersect ! DYNAMICS_QUATERNIONS public :: quaternion public :: abs public :: conjg public :: real public :: aimag public :: inverse public :: exp public :: log public :: dot_product ! OPERATORS public :: operator ( + ) public :: operator ( - ) public :: operator ( * ) public :: operator ( / ) public :: assignment ( = ) public :: operator ( ** ) end module","tags":"","loc":"sourcefile\\dynamics.f90.html"},{"title":"dynamics_controls.f90 – DYNAMICS","text":"Contents Modules dynamics_controls Source Code dynamics_controls.f90 Source Code module dynamics_controls use iso_fortran_env use nonlin_polynomials use ferror use ieee_arithmetic use dynamics_error_handling use diffeq use linalg , only : eigen use lapack , only : dgetrf , dgetri , dgetrs , zgels implicit none private public :: polynomial public :: state_space public :: transfer_function public :: operator ( * ) public :: lti_solve public :: ss_excitation public :: ode_integrator ! ------------------------------------------------------------------------------ type state_space !! Defines a state-space representation of a dynamic system. This !! implementation takes the form: !! !! \\dot{x}(t) = A x(t) + B u(t) !! y(t) = C x(t) + D u(t) !! !! Where: !! !! - t denotes time. !! !! - x(t) is the state vector. !! !! - u(t) is the input vector. !! !! - y(t) is the output vector. real ( real64 ), allocatable , dimension (:,:) :: A !! The N-by-N dynamics matrix, where N is the number of state !! variables. real ( real64 ), allocatable , dimension (:,:) :: B !! The N-by-M input matrix, where M is the number of inputs. real ( real64 ), allocatable , dimension (:,:) :: C !! The P-by-N output matrix, where P is the number of outputs. real ( real64 ), allocatable , dimension (:,:) :: D !! The P-by-M feedthrough matrix. contains procedure , public :: evaluate_derivatives => ss_eval_deriv procedure , public :: evaluate_output => ss_eval_output procedure , public :: poles => ss_poles procedure , public :: zeros => ss_zeros generic , public :: transfer_function => ss_transfer_fcn , & ss_transfer_fcn_omega , ss_transfer_fcn_array , & ss_transfer_fcn_omega_array procedure , private :: ss_transfer_fcn procedure , private :: ss_transfer_fcn_omega procedure , private :: ss_transfer_fcn_array procedure , private :: ss_transfer_fcn_omega_array end type interface state_space module procedure :: state_space_init module procedure :: state_space_init_scalar module procedure :: state_space_init_matrices module procedure :: state_space_init_pid module procedure :: state_space_init_pid_plant end interface ! ------------------------------------------------------------------------------ type transfer_function !! Defines a transfer function for a continuous system of the form !! H(s) = \\frac{Y(s)}{X(s)} . type ( polynomial ) :: Y !! The numerator polynomial Y(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! y_1 + y_2 s + y_3 s^2 ... . type ( polynomial ) :: X !! The denominator polynomial X(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! x_1 + x_2 s + x_3 s^2 ... . contains procedure , private :: tf_eval_s procedure , private :: tf_eval_omega generic , public :: evaluate => tf_eval_omega , tf_eval_s procedure , public :: poles => tf_poles procedure , public :: zeros => tf_zeros procedure , public :: to_ccf_state_space => tf_to_ccf_statespace procedure , public :: to_ocf_state_space => tf_to_ocf_statespace end type interface transfer_function module procedure :: init_tf_array module procedure :: init_tf_poly end interface ! ------------------------------------------------------------------------------ interface operator ( * ) module procedure :: tf_tf_mult module procedure :: poly_tf_mult module procedure :: tf_poly_mult module procedure :: tf_scalar_mult module procedure :: scalar_tf_mult end interface ! ------------------------------------------------------------------------------ interface subroutine ss_excitation ( t , u , args ) !! A routine for computing the excitation vector for a state-space !! model. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: t !! The time value at which to compute the excitation. real ( real64 ), intent ( out ), dimension (:) :: u !! The excitation vector. class ( * ), intent ( inout ), optional :: args !! An optional argument used to pass objects in and out of the !! routine. end subroutine end interface ! ------------------------------------------------------------------------------ ! PRIVATE TYPES ! ------------------------------------------------------------------------------ type argument_container procedure ( ss_excitation ), pointer , nopass :: excitation class ( * ), allocatable :: user_args logical :: has_user_args class ( state_space ), pointer :: model end type contains ! ****************************************************************************** ! STATE_SPACE ! ------------------------------------------------------------------------------ pure function state_space_init ( m , b , k , n_out ) result ( rst ) !! Initializes the state space model. !! !! The output matrix C is initialized to one, and the !! feedthrough matrix D is initialized to zero. real ( real64 ), intent ( in ), dimension (:,:) :: m !! The N-by-N mass matrix. real ( real64 ), intent ( in ), dimension ( size ( m , 1 ), size ( m , 2 )) :: b !! The N-by-N damping matrix. real ( real64 ), intent ( in ), dimension ( size ( m , 1 ), size ( m , 2 )) :: k !! The N-by-N stiffness matrix. integer ( int32 ), intent ( in ), optional :: n_out !! The number of outputs. The default is 1. type ( state_space ) :: rst !! The [[state_space]] model. ! Local Variables integer ( int32 ) :: ii , jj , n , p , q , lwork , info integer ( int32 ), allocatable , dimension (:) :: pvt real ( real64 ) :: temp ( 1 ) real ( real64 ), allocatable , dimension (:) :: work ! Initialization p = size ( m , 1 ) n = 2 * p q = 1 if ( present ( n_out )) q = n_out if ( q <= 1 ) q = 1 allocate ( & rst % A ( n , n ), & rst % B ( n , p ), & rst % D ( q , p ), & source = 0.0d0 & ) allocate ( rst % C ( q , n ), source = 1.0d0 ) allocate ( pvt ( p )) ! Workspace call dgetri ( p , rst % b ( p + 1 : n ,:), p , pvt , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Build p-by-p Identity sub-matrix matrix jj = p + 1 do ii = 1 , p rst % A ( ii , jj ) = 1.0d0 jj = jj + 1 end do ! Fill in the matrices rst % B ( p + 1 : n , 1 : p ) = m rst % A ( p + 1 : n , 1 : p ) = - k rst % A ( p + 1 : n , p + 1 : n ) = - b call dgetrf ( p , p , rst % B ( p + 1 : n , 1 : p ), p , pvt , info ) call dgetrs ( 'N' , p , p , rst % B ( p + 1 : n , 1 : p ), p , pvt , rst % A ( p + 1 : n , 1 : p ), p , & info ) call dgetrs ( 'N' , p , p , rst % B ( p + 1 : n , 1 : p ), p , pvt , rst % A ( p + 1 : n , p + 1 : n ), & p , info ) call dgetri ( p , rst % B ( p + 1 : n , 1 : p ), p , pvt , work , lwork , info ) end function ! ------------------------------------------------------------------------------ pure function state_space_init_scalar ( m , b , k ) result ( rst ) !! Initializes the state space model. !! !! The output matrix C is initialized to one, and the !! feedthrough matrix D is initialized to zero. real ( real64 ), intent ( in ) :: m !! The mass. real ( real64 ), intent ( in ) :: b !! The damping. real ( real64 ), intent ( in ) :: k !! The stiffness. type ( state_space ) :: rst !! The [[state_space]] model. ! Process allocate ( & rst % A ( 2 , 2 ), & rst % B ( 2 , 1 ), & rst % D ( 1 , 1 ), & source = 0.0d0 & ) allocate ( rst % C ( 1 , 2 ), source = 1.0d0 ) rst % A ( 2 , 1 ) = - k / m rst % A ( 1 , 2 ) = 1.0d0 rst % A ( 2 , 2 ) = - b / m rst % B ( 2 , 1 ) = 1.0d0 / m end function ! ------------------------------------------------------------------------------ pure function state_space_init_matrices ( a , b , c , d ) result ( rst ) !! Initializes the state space model. real ( real64 ), intent ( in ), dimension (:,:) :: a !! The N-by-N dynamics matrix. real ( real64 ), intent ( in ), dimension (:,:) :: b !! The N-by-M input matrix. real ( real64 ), intent ( in ), dimension (:,:) :: c !! The P-by-N output matrix. real ( real64 ), intent ( in ), dimension (:,:) :: d !! The P-by-M feedthrough matrix. type ( state_space ) :: rst !! The resulting [[state_space]] object. allocate ( rst % A , source = a ) allocate ( rst % B , source = b ) allocate ( rst % C , source = c ) allocate ( rst % D , source = d ) end function ! ------------------------------------------------------------------------------ pure function state_space_init_pid ( kp , ki , kd , tau , a , b , c , d ) result ( rst ) !! Initializes a state-space model that employs a closed-loop PID !! controller. !! !! The PID model is augmented into the plant model as follows. !! !! e = r - y !! \\dot{x_1} = e !! \\dot{x_3} = -\\frac{x_3}{\\tau} + \\frac{e}{\\tau} !! u = K_{i} x_{i} + K_{p} e + \\frac{K_{d}}{\\tau} \\left(e - !! x_{3} \\right) !! \\alpha = K_{p} + \\frac{K_{d}}{\\tau} !! \\beta = \\frac{1}{1 + \\alpha D} !! x = \\left[ \\begin{matrix} x_{p} \\\\ x_{1} \\\\ x_{3} \\end{matrix} !! \\right] !! \\dot{x} = A_{cl} x + B_{cl} r !! y = C_{cl} x + D_{cl} r !! !! Where the augmented matrices are as follows. !! !! A_{cl} = \\left[ \\begin{matrix} A - \\alpha \\beta B C & !! \\beta K_{i} B & -\\frac{\\beta K_{d}}{\\tau} B \\\\ !! -C + \\alpha \\beta D C & -\\beta K_{i} D & \\frac{\\beta K_{d}}{\\tau} D !! \\\\ \\frac{1}{\\tau}\\left(-C + \\alpha \\beta D C \\right) & !! -\\frac{\\beta K_{i}}{\\tau} D & \\frac{1}{\\tau} \\left( !! 1 + \\frac{\\beta K_{d}}{\\tau^{2}} D \\right) \\end{matrix} \\right] !! B_{cl} = \\left[ \\begin{matrix} \\alpha \\beta B \\\\ 1 - !! \\alpha \\beta D \\\\ \\frac{1}{\\tau} \\left( 1 - \\alpha \\beta D \\right) !! \\end{matrix} \\right] !! C_{cl} = \\left[ \\begin{matrix} C - \\alpha \\beta D C & !! \\beta K_{i} D & -\\frac{\\beta K_{d}}{\\tau} D \\end{matrix} \\right] !! D_{cl} = \\alpha \\beta D real ( real64 ), intent ( in ) :: kp !! The proportional gain term. real ( real64 ), intent ( in ) :: ki !! The integral gain term. real ( real64 ), intent ( in ) :: kd !! The derivative gain term. real ( real64 ), intent ( in ) :: tau !! The time constant of the first order derivative filter !! K_{d} \\frac{s}{\\tau s + 1} . real ( real64 ), intent ( in ), dimension (:,:) :: a !! The N-by-N dynamics matrix for the plant. real ( real64 ), intent ( in ), dimension ( size ( a , 1 ), 1 ) :: b !! The N-by-1 input matrix for the plant. real ( real64 ), intent ( in ), dimension ( 1 , size ( a , 1 )) :: c !! The 1-by-N output matrix for the plant. real ( real64 ), intent ( in ), dimension ( 1 , 1 ) :: d !! The 1-by-1 feedthrough matrix for the plant. type ( state_space ) :: rst !! The resulting [[state_space]] object. ! Local Variables integer ( int32 ) :: n , n1 , n2 real ( real64 ) :: alpha , beta , ab real ( real64 ), allocatable , dimension (:,:) :: dc ! Initialization n = size ( a , 1 ) n1 = n + 1 n2 = n + 2 allocate ( & rst % A ( n2 , n2 ), & rst % B ( n2 , 1 ), & rst % C ( 1 , n2 ), & rst % D ( 1 , 1 ) & ) dc = matmul ( d , c ) ! Process alpha = kp + kd / tau if ( d ( 1 , 1 ) == 0.0d0 ) then beta = 1.0d0 else beta = 1.0d0 / ( 1.0d0 + alpha * d ( 1 , 1 )) end if ab = alpha * beta rst % A ( 1 : n , 1 : n ) = a - ab * matmul ( b , c ) rst % A ( n1 , 1 : n ) = - c ( 1 , 1 : n ) + ab * dc ( 1 , 1 : n ) rst % A ( 4 , 1 : n ) = ( 1.0d0 / tau ) * rst % A ( 3 , 1 : 2 ) rst % A ( 1 : n , n1 ) = beta * ki * b ( 1 : n , 1 ) rst % A ( n1 , n1 ) = - beta * ki * d ( 1 , 1 ) rst % A ( n2 , n1 ) = rst % A ( 3 , 3 ) / tau rst % A ( 1 : n , n2 ) = - ( beta * kd / tau ) * b ( 1 : n , 1 ) rst % A ( n1 , n2 ) = beta * kd * d ( 1 , 1 ) / tau rst % A ( n2 , n2 ) = - 1.0d0 / tau + beta * kd * d ( 1 , 1 ) / ( tau ** 2 ) rst % B ( 1 : n , 1 ) = ab * b ( 1 : n , 1 ) rst % B ( n1 , 1 ) = 1.0d0 - ab * d ( 1 , 1 ) rst % B ( n2 , 1 ) = ( 1.0d0 / tau ) * rst % B ( 3 , 1 ) rst % C ( 1 , 1 : n ) = c ( 1 , 1 : n ) - ab * dc ( 1 , 1 : n ) rst % C ( 1 , n1 ) = beta * ki * d ( 1 , 1 ) rst % C ( 1 , n2 ) = - ( beta * kd / tau ) * d ( 1 , 1 ) rst % D = ab * d end function ! ------------------------------------------------------------------------------ pure function state_space_init_pid_plant ( kp , ki , kd , tau , plant ) result ( rst ) !! Initializes a state-space model that employs a closed-loop PID !! controller. !! !! The PID model is augmented into the plant model as follows. !! !! e = r - y !! \\dot{x_1} = e !! \\dot{x_3} = -\\frac{x_3}{\\tau} + \\frac{e}{\\tau} !! u = K_{i} x_{i} + K_{p} e + \\frac{K_{d}}{\\tau} \\left(e - !! x_{3} \\right) !! \\alpha = K_{p} + \\frac{K_{d}}{\\tau} !! \\beta = \\frac{1}{1 + \\alpha D} !! x = \\left[ \\begin{matrix} x_{p} \\\\ x_{1} \\\\ x_{3} \\end{matrix} !! \\right] !! \\dot{x} = A_{cl} x + B_{cl} r !! y = C_{cl} x + D_{cl} r !! !! Where the augmented matrices are as follows. !! !! A_{cl} = \\left[ \\begin{matrix} A - \\alpha \\beta B C & !! \\beta K_{i} B & -\\frac{\\beta K_{d}}{\\tau} B \\\\ !! -C + \\alpha \\beta D C & -\\beta K_{i} D & \\frac{\\beta K_{d}}{\\tau} D !! \\\\ \\frac{1}{\\tau}\\left(-C + \\alpha \\beta D C \\right) & !! -\\frac{\\beta K_{i}}{\\tau} D & \\frac{1}{\\tau} \\left( !! 1 + \\frac{\\beta K_{d}}{\\tau^{2}} D \\right) \\end{matrix} \\right] !! B_{cl} = \\left[ \\begin{matrix} \\alpha \\beta B \\\\ 1 - !! \\alpha \\beta D \\\\ \\frac{1}{\\tau} \\left( 1 - \\alpha \\beta D \\right) !! \\end{matrix} \\right] !! C_{cl} = \\left[ \\begin{matrix} C - \\alpha \\beta D C & !! \\beta K_{i} D & -\\frac{\\beta K_{d}}{\\tau} D \\end{matrix} \\right] !! D_{cl} = \\alpha \\beta D real ( real64 ), intent ( in ) :: kp !! The proportional gain term. real ( real64 ), intent ( in ) :: ki !! The integral gain term. real ( real64 ), intent ( in ) :: kd !! The derivative gain term. real ( real64 ), intent ( in ) :: tau !! The time constant of the first order derivative filter !! K_{d} \\frac{s}{\\tau s + 1} . class ( state_space ), intent ( in ) :: plant !! The plant model. type ( state_space ) :: rst !! The resulting [[state_space]] object. rst = state_space_init_pid ( kp , ki , kd , tau , plant % A , plant % B , & plant % C , plant % D ) end function ! ------------------------------------------------------------------------------ pure function ss_eval_deriv ( this , u , x ) result ( rst ) !! Evaluates the state time derivative \\dot{x}(t) = A x(t) + !! B u(t) . class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ), dimension (:) :: u !! The M-element input array. real ( real64 ), intent ( in ), dimension (:) :: x !! The N-element state array. real ( real64 ), allocatable , dimension (:) :: rst !! The N-element state time derivative vector. rst = matmul ( this % A , x ) + matmul ( this % B , u ) end function ! ------------------------------------------------------------------------------ pure function ss_eval_output ( this , u , x ) result ( rst ) !! Evaluates the output vector y(t) = C x(t) + D u(t) . class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ), dimension (:) :: u !! The M-element input array. real ( real64 ), intent ( in ), dimension (:) :: x !! The N-element state array. real ( real64 ), allocatable , dimension (:) :: rst !! The P-element output array. rst = matmul ( this % C , x ) + matmul ( this % D , u ) end function ! ------------------------------------------------------------------------------ function ss_poles ( this , err ) result ( rst ) !! Computes the poles of the state space model. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The poles of the model. ! Local Variables integer ( int32 ) :: n real ( real64 ), allocatable , dimension (:,:) :: ac ! Process n = size ( this % A , 1 ) allocate ( rst ( n )) if ( n == 0 ) return allocate ( ac ( n , n ), source = this % A ) call eigen ( ac , rst , err = err ) end function ! ------------------------------------------------------------------------------ function ss_zeros ( this , err ) result ( rst ) !! Computes the zeros of the state space model. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The zeros of the model. ! Local Variables integer ( int32 ) :: i , j , n , m , p , nz real ( real64 ), allocatable , dimension (:,:) :: Az , Bz complex ( real64 ), allocatable , dimension (:) :: buffer , trimmed ! Initialization n = size ( this % A , 1 ) m = size ( this % B , 2 ) p = size ( this % C , 1 ) nz = n + max ( m , p ) allocate ( Az ( nz , nz ), Bz ( nz , nz ), source = 0.0d0 ) allocate ( buffer ( nz ), trimmed ( nz )) ! Build the matrices Az ( 1 : n , 1 : n ) = this % A Az ( 1 : n , n + 1 : n + m ) = this % B do i = 1 , nz Bz ( i , i ) = 1.0d0 end do Bz ( n + 1 : n + p , 1 : n ) = this % C Bz ( n + 1 : n + p , n + 1 : n + m ) = this % D ! Compute the eigenvalues call eigen ( Az , Bz , buffer ) ! Only keep the physically realizable zeros - exclude NaN's and (0,0) j = 0 do i = 1 , nz if ( ieee_is_nan ( real ( buffer ( i )))) cycle if ( ieee_is_nan ( aimag ( buffer ( i )))) cycle if (. not . ieee_is_finite ( real ( buffer ( i )))) cycle if (. not . ieee_is_finite ( aimag ( buffer ( i )))) cycle if ( abs ( buffer ( i )) <= epsilon ( 0.0d0 )) cycle j = j + 1 trimmed ( j ) = buffer ( i ) end do rst = trimmed ( 1 : j ) end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn ( this , s ) result ( rst ) !! Evaluates the transfer functions for the model at the parameter s. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. complex ( real64 ), intent ( in ) :: s !! The frequency at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting transfer functions. ! Local Variables integer ( int32 ) :: j , ninput , noutput , n , info , lwork complex ( real64 ) :: temp ( 1 ) complex ( real64 ), allocatable , dimension (:) :: work , Bj complex ( real64 ), allocatable , dimension (:,:) :: A , Ac ! Initialization n = size ( this % A , 1 ) ninput = size ( this % B , 2 ) noutput = size ( this % C , 1 ) allocate ( rst ( noutput , ninput )) allocate ( Ac ( n , n ), Bj ( n )) ! Determine DGELS workspace requirements call zgels ( 'N' , n , n , 1 , Ac , n , Bj , n , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Build s * I - A do j = 1 , n Ac (:, j ) = - this % A (:, j ) Ac ( j , j ) = Ac ( j , j ) + s end do allocate ( A ( n , n ), source = Ac ) ! For each column j, solve Ac * x(j) = B(j) and then compute ! the output: C x(j) + D(j) do j = 1 , ninput if ( j /= 1 ) A = Ac ! We need a copy as A will be overwritten Bj = this % B (:, j ) call zgels ( 'N' , n , n , 1 , A , n , Bj , n , work , lwork , info ) rst (:, j ) = matmul ( this % C , Bj ) + this % D (:, j ) end do end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn_omega ( this , omega ) result ( rst ) !! Evaluates the transfer functions for the model at frequency \\omega. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ) :: omega !! The frequency at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting transfer functions. ! Local Variables complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) complex ( real64 ) :: s ! Process s = j * omega rst = ss_transfer_fcn ( this , s ) end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn_array ( this , s ) result ( rst ) !! Evaluates the transfer functions for the model at the frequencies given !! in the array s. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. complex ( real64 ), intent ( in ), dimension (:) :: s !! The frequencies at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:,:) :: rst !! The resulting transfer functions, with each page of the array !! containing the transfer functions for a specific frequency. ! Local Variables integer ( int32 ) :: i , ninput , noutput , n ! Initialization ninput = size ( this % B , 2 ) noutput = size ( this % C , 1 ) n = size ( s ) allocate ( rst ( noutput , ninput , n )) ! Process do concurrent ( i = 1 : n ) rst (:,:, i ) = ss_transfer_fcn ( this , s ( i )) end do end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn_omega_array ( this , omega ) result ( rst ) !! Evaluates the transfer functions for the model at the frequencies given !! in the array omega. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ), dimension (:) :: omega !! The frequencies at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:,:) :: rst !! The resulting transfer functions, with each page of the array !! containing the transfer functions for a specific frequency. ! Local Variables integer ( int32 ) :: i , ninput , noutput , n ! Initialization ninput = size ( this % B , 2 ) noutput = size ( this % C , 1 ) n = size ( omega ) allocate ( rst ( noutput , ninput , n )) ! Process do concurrent ( i = 1 : n ) rst (:,:, i ) = ss_transfer_fcn_omega ( this , omega ( i )) end do end function ! ****************************************************************************** ! TRANSFER_FUNCTION ! ------------------------------------------------------------------------------ function init_tf_poly ( y , x ) result ( rst ) !! Initializes a new transfer function. class ( polynomial ), intent ( in ) :: y !! The numerator polynomial Y(s) in !! H(s) = \\frac{Y(s)}{X(s)} . class ( polynomial ), intent ( in ) :: x !! The denominator polynomial X(s) in !! H(s) = \\frac{Y(s)}{X(s)} . type ( transfer_function ) :: rst !! The resulting [[transfer_function]]. ! Process call rst % Y % initialize ( y % get_all ()) call rst % X % initialize ( x % get_all ()) end function ! ------------------------------------------------------------------------------ function init_tf_array ( y , x ) result ( rst ) !! Initializes a new transfer function. real ( real64 ), intent ( in ), dimension (:) :: y !! The numerator polynomial Y(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! y_1 + y_2 s + y_3 s^2 ... . real ( real64 ), intent ( in ), dimension (:) :: x !! The denominator polynomial X(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! x_1 + x_2 s + x_3 s^2 ... . type ( transfer_function ) :: rst !! The resulting [[transfer_function]]. ! Process call rst % Y % initialize ( y ) call rst % X % initialize ( x ) end function ! ------------------------------------------------------------------------------ pure elemental function tf_eval_s ( this , s ) result ( rst ) !! Evaluates the transfer function at the specified value of the !! Laplace variable s. class ( transfer_function ), intent ( in ) :: this !! The transfer_function object. complex ( real64 ), intent ( in ) :: s !! The Laplace variable at which to evaluate the transfer function. complex ( real64 ) :: rst !! The value of the transfer function. ! Process rst = this % Y % evaluate ( s ) / this % X % evaluate ( s ) end function ! ------------------------------------------------------------------------------ pure elemental function tf_eval_omega ( this , omega ) result ( rst ) !! Evaluates the transfer function at the specified value of the !! \\omega. class ( transfer_function ), intent ( in ) :: this !! The transfer_function object. real ( real64 ), intent ( in ) :: omega !! The frequency, in rad/s, at which to evaluate the transfer !! function. complex ( real64 ) :: rst !! The value of the transfer function. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) ! Local Variables complex ( real64 ) :: s ! Process s = j * omega rst = this % tf_eval_s ( s ) end function ! ------------------------------------------------------------------------------ function tf_poles ( this , err ) result ( rst ) !! Computes the poles of the transfer function. class ( transfer_function ), intent ( in ) :: this !! The transfer_function object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The poles of the transfer function. ! Process rst = this % X % roots ( err = err ) end function ! ------------------------------------------------------------------------------ function tf_zeros ( this , err ) result ( rst ) !! Computes the zeros of the transfer function. class ( transfer_function ), intent ( in ) :: this !! The transfer function object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The zeros of the transfer function. ! Process rst = this % Y % roots ( err = err ) end function ! ------------------------------------------------------------------------------ function tf_to_ccf_statespace ( this ) result ( rst ) !! Converts a transfer_function type into a controllable canonical form !! state_space type. See !! [this](https://en.wikipedia.org/wiki/State-space_representation) article !! for a description of this form. class ( transfer_function ), intent ( in ) :: this !! The transfer_function to convert. type ( state_space ) :: rst !! The resulting state-space object. ! Local Variables integer ( int32 ) :: i , order , n , norder real ( real64 ) :: a ! Process order = this % X % order () n = order + 1 allocate ( rst % A ( order , order ), rst % B ( order , 1 ), rst % C ( 1 , order ), & rst % D ( 1 , 1 ), source = 0.0d0 ) a = this % X % get ( n ) do i = 1 , order rst % A ( order , i ) = - this % X % get ( i ) / a end do do i = 1 , order - 1 rst % A ( i , i + 1 ) = 1.0d0 end do rst % B ( order , 1 ) = 1.0d0 norder = this % Y % order () do i = 1 , min ( norder + 1 , order ) rst % C ( 1 , i ) = this % Y % get ( i ) / a end do end function ! ------------------------------------------------------------------------------ function tf_to_ocf_statespace ( this ) result ( rst ) !! Converts a transfer_function type into an observable canonical form !! state_space type. See !! [this](https://en.wikipedia.org/wiki/State-space_representation) article !! for a description of this form. class ( transfer_function ), intent ( in ) :: this !! The transfer_function to convert. type ( state_space ) :: rst !! The resulting state-space object. ! Local Variables integer ( int32 ) :: i , order , n , norder real ( real64 ) :: a ! Process order = this % X % order () n = order + 1 allocate ( rst % A ( order , order ), rst % B ( order , 1 ), rst % C ( 1 , order ), & rst % D ( 1 , 1 ), source = 0.0d0 ) a = this % X % get ( n ) do i = 1 , order rst % A ( i , order ) = - this % X % get ( i ) / a end do do i = 1 , order - 1 rst % A ( i + 1 , i ) = 1.0d0 end do norder = this % Y % order () do i = 1 , min ( norder + 1 , order ) rst % B ( i , 1 ) = this % Y % get ( i ) / a end do rst % C ( 1 , order ) = 1.0d0 end function ! ****************************************************************************** ! OPERATORS ! ------------------------------------------------------------------------------ function tf_tf_mult ( x , y ) result ( rst ) !! Multiplies two transfer functions. class ( transfer_function ), intent ( in ) :: x !! The left-hand-side argument. class ( transfer_function ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x % Y * y % Y rst % X = x % X * y % X end function ! ------------------------------------------------------------------------------ function poly_tf_mult ( x , y ) result ( rst ) !! Multiplies a polynomial and a transfer function to result in a new !! transfer function. class ( polynomial ), intent ( in ) :: x !! The left-hand-side argument. class ( transfer_function ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x * y % Y rst % X = y % X end function ! ------------------------------------------------------------------------------ function tf_poly_mult ( x , y ) result ( rst ) !! Multiplies a transfer function and a polynomial to result in a new !! transfer function. class ( transfer_function ), intent ( in ) :: x !! The left-hand-side argument. class ( polynomial ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x % Y * y rst % X = x % X end function ! ------------------------------------------------------------------------------ function tf_scalar_mult ( x , y ) result ( rst ) !! Multiplies a transfer function by a scalar value. class ( transfer_function ), intent ( in ) :: x !! The left-hand-side argument. real ( real64 ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = y * x % Y rst % X = x % X end function ! ------------------------------------------------------------------------------ function scalar_tf_mult ( x , y ) result ( rst ) !! Multiplies a transfer function by a scalar value. real ( real64 ), intent ( in ) :: x !! The left-hand-side argument. class ( transfer_function ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x * y % Y rst % X = y % X end function ! ****************************************************************************** ! LTI SOLVERS ! ------------------------------------------------------------------------------ function lti_solve ( mdl , u , t , ic , solver , args , err ) result ( rst ) !! Solves the LTI system given by the specified state space model. class ( state_space ), intent ( in ), target :: mdl !! The state_space model to solve. procedure ( ss_excitation ), pointer , intent ( in ) :: u !! The routine used to compute the excitation vector. real ( real64 ), intent ( in ), dimension (:) :: t !! The time points at which to compute the solution. The array must !! have at least 2 values; however, more may be specified. If only !! 2 values are specified, the integrator will compute the solution at !! those points, but it will also return any intermediate integration !! steps that may be required. However, if more than 2 points are !! given, the integrator will return the solution values only at the !! specified time points. real ( real64 ), intent ( in ), dimension (:) :: ic !! The initial condition vector. This array must be the same size as !! the number of state variables. class ( ode_integrator ), intent ( in ), optional , target :: solver !! The ODE solver to utilize. If not specified, the default solver !! is a 4th/5th order Runge-Kutta integrator. class ( * ), intent ( inout ), optional :: args !! An optional container for arguments to pass to the excitation !! routine. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The solution. The time points at which the solution was evaluated !! are stored in the first column and the output(s) are stored in the !! remaining column(s). ! Local Variables integer ( int32 ) :: i , n , npts , flag , nInputs , nOutputs real ( real64 ), allocatable , dimension (:) :: uv real ( real64 ), allocatable , dimension (:,:) :: sol type ( argument_container ) :: container class ( errors ), pointer :: errmgr type ( errors ), target :: deferr class ( ode_integrator ), pointer :: integrator type ( runge_kutta_45 ), target :: defaultIntegrator type ( ode_container ) :: odeMdl ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if container % excitation => u container % model => mdl container % has_user_args = present ( args ) if ( present ( args )) allocate ( container % user_args , source = args ) n = size ( mdl % A , 1 ) nInputs = size ( mdl % B , 2 ) nOutputs = size ( mdl % C , 1 ) ! Input Checking if ( size ( ic ) /= n ) then call report_array_size_error ( \"lti_solve_statespace\" , \"ic\" , n , & size ( ic ), errmgr ) return end if ! Set up the integrator if ( present ( solver )) then integrator => solver else integrator => defaultIntegrator end if odeMdl % fcn => ode_solver_routine ! Call the solver call integrator % solve ( odeMdl , t , ic , args = container , err = errmgr ) if ( errmgr % has_error_occurred ()) return ! Get the output from the solver sol = integrator % get_solution () npts = size ( sol , 1 ) allocate ( rst ( npts , nOutputs + 1 ), uv ( nInputs ), stat = flag , source = 0.0d0 ) if ( flag /= 0 ) then call report_memory_error ( \"lti_solve_statespace\" , flag , errmgr ) return end if ! Compute: C * x + D * u do i = 1 , npts call u ( sol ( i , 1 ), uv , args ) rst ( i , 1 ) = sol ( i , 1 ) rst ( i , 2 :) = mdl % evaluate_output ( uv , sol ( i , 2 :)) end do end function ! ---------- subroutine ode_solver_routine ( t , x , dxdt , args ) ! The routine called by the LTI solver real ( real64 ), intent ( in ) :: t , x (:) real ( real64 ), intent ( out ) :: dxdt (:) class ( * ), intent ( inout ), optional :: args ! Local Variables integer ( int32 ) :: n , p real ( real64 ) :: nan real ( real64 ), allocatable , dimension (:) :: u ! Initialization nan = ieee_value ( nan , IEEE_QUIET_NAN ) ! Process select type ( args ) class is ( argument_container ) ! Evaluate the excitation vector at t n = size ( args % model % B , 2 ) allocate ( u ( n ), source = 0.0d0 ) if ( args % has_user_args ) then call args % excitation ( t , u , args = args % user_args ) else call args % excitation ( t , u ) end if ! Evaluate the model dxdt = args % model % evaluate_derivatives ( u , x ) class default dxdt = nan end select end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_controls.f90.html"},{"title":"dynamics_error_handling.f90 – DYNAMICS","text":"Contents Modules dynamics_error_handling Source Code dynamics_error_handling.f90 Source Code module dynamics_error_handling use ferror use iso_fortran_env use diffeq_errors , only : DIFFEQ_INVALID_INPUT_ERROR , & DIFFEQ_MEMORY_ALLOCATION_ERROR , DIFFEQ_NULL_POINTER_ERROR use fstats_errors , only : FS_UNDERDEFINED_PROBLEM_ERROR , & FS_TOLERANCE_TOO_SMALL_ERROR , FS_TOO_FEW_ITERATION_ERROR use nonlin_error_handling , only : NL_CONVERGENCE_ERROR implicit none integer ( int32 ), parameter :: DYN_MEMORY_ERROR = DIFFEQ_MEMORY_ALLOCATION_ERROR !! Defines an error associated with memory allocations. integer ( int32 ), parameter :: DYN_NULL_POINTER_ERROR = DIFFEQ_NULL_POINTER_ERROR !! Defines an error associated with a null pointer. integer ( int32 ), parameter :: DYN_INVALID_INPUT_ERROR = DIFFEQ_INVALID_INPUT_ERROR !! Defines an error associated with an invalid input. integer ( int32 ), parameter :: DYN_MATRIX_SIZE_ERROR = 100100 !! Defines an error associated with an incorrectly sized matrix. integer ( int32 ), parameter :: DYN_ZERO_VALUED_FREQUENCY_ERROR = 100101 !! Defines an error associated with a zero-valued frequency. integer ( int32 ), parameter :: DYN_CONSTRAINT_ERROR = 100102 !! Defines a constraint-related error. integer ( int32 ), parameter :: DYN_INDEX_OUT_OF_RANGE = 100103 !! Defines an index out of range error. integer ( int32 ), parameter :: DYN_NONMONOTONIC_ARRAY_ERROR = 100104 !! Defines an error related to an array being nonmonotonic. integer ( int32 ), parameter :: DYN_ARRAY_SIZE_ERROR = 100105 !! Defines an error for an improperly sized array. integer ( int32 ), parameter :: DYN_UNDERDEFINED_PROBLEM_EROR = FS_UNDERDEFINED_PROBLEM_ERROR !! Defines an error for an underdefined problem. integer ( int32 ), parameter :: DYN_TOLERANCE_TOO_SMALL_ERROR = FS_TOLERANCE_TOO_SMALL_ERROR !! Defines an error related to the request of a too small tolerance !! value. integer ( int32 ), parameter :: DYN_TOO_FEW_ITERATIONS_ERROR = FS_TOO_FEW_ITERATION_ERROR !! Defines an error when too few iterations were allowed. integer ( int32 ), parameter :: DYN_CONVERGENCE_ERROR = NL_CONVERGENCE_ERROR !! Defines an error related to convergence issues. contains ! ------------------------------------------------------------------------------ subroutine report_null_forcing_routine_error ( name , err ) !! Reports a null forcing routine pointer error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Report the error call err % report_error ( name , & \"No forcing function routine was supplied.\" , & DYN_NULL_POINTER_ERROR ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_null_solver_routine_error ( name , err ) !! Reports a null solver routine error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Report the error call err % report_error ( name , & \"No routine has been defined to supply to the solver.\" , & DYN_NULL_POINTER_ERROR ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_memory_error ( name , flag , err ) !! Reports a memory allocation error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: flag !! The flag returned from the allocate statement. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Memory allocation error flag \" , flag , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MEMORY_ERROR ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonsquare_mass_matrix_error ( name , m , n , err ) !! Reports an error relating to a non-square mass matrix. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: m !! The number of rows found in the mass matrix. integer ( int32 ), intent ( in ) :: n !! The number of columns found in the mass matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The mass matrix is not square. \" // & \"It was found to be \" , m , \"-by-\" , n , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonsquare_stiffness_matrix_error ( name , m , n , err ) !! Reports an error relating to a non-square stiffness matrix. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: m !! The number of rows found in the stiffness matrix. integer ( int32 ), intent ( in ) :: n !! The number of columns found in the stiffness matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The stiffness matrix is not square. \" // & \"It was found to be \" , m , \"-by-\" , n , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonsquare_matrix_error ( name , var , m , n , err ) !! Reports an error relating to a non-square matrix. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: m !! The number of rows found in the matrix. integer ( int32 ), intent ( in ) :: n !! The number of columns found in the matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Matrix \" // var // \" is not square. \" // & \"It was found to be \" , m , \"-by-\" , n , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_matrix_size_mismatch_error ( name , mtx1 , mtx2 , m1 , n1 , & m2 , n2 , err ) !! Reports a mismatch in matrix sizes. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: mtx1 !! The name of the first matrix. character ( len = * ), intent ( in ) :: mtx2 !! The name of the second matrix. integer ( int32 ), intent ( in ) :: m1 !! The number of rows in the first matrix. integer ( int32 ), intent ( in ) :: n1 !! The number of columns in the first matrix. integer ( int32 ), intent ( in ) :: m2 !! The number of rows in the second matrix. integer ( int32 ), intent ( in ) :: n2 !! The number of columns in the second matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The size of the \" // mtx1 // \" matrix (\" , m1 , & \"-by-\" , n1 , \") does not match the size of the \" // mtx2 , & \" matrix (\" , m2 , \"-by-\" , n2 , \").\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_zero_valued_frequency_error ( name , index , err ) !! Reports an error associated with a zero-valued frequency value. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: index !! The array index at which the zero-valued frequency was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"A zero-valued frequency was found at index \" , & index , \".\" call err % report_error ( name , trim ( errmsg ), & DYN_ZERO_VALUED_FREQUENCY_ERROR ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_generic_counting_error ( name , str1 , val , str2 , flag , err ) !! A generic error reporting routine. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: str1 !! The first string. integer ( int32 ), intent ( in ) :: val !! The integer value. character ( len = * ), intent ( in ) :: str2 !! The second string. integer ( int32 ), intent ( in ) :: flag !! The error flag. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 512 ) :: errmsg ! Report the error write ( errmsg , 100 ) str1 , val , str2 call err % report_error ( name , trim ( errmsg ), flag ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_zero_difference_error ( name , var1 , val1 , var2 , val2 , & flag , err ) !! Reports a zero-difference between two variables where a non-zero !! difference was expected. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var1 !! The name of the first variable. real ( real64 ), intent ( in ) :: val1 !! The value of the first variable. character ( len = * ), intent ( in ) :: var2 !! The name of the second variable. real ( real64 ), intent ( in ) :: val2 !! The value of the second variable. integer ( int32 ), intent ( in ) :: flag !! The error flag. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"A non-zero difference between \" // var1 // & \" (\" , val1 , \"), and \" // var2 // \" (\" , val2 , \") was expected.\" call err % report_error ( name , trim ( errmsg ), flag ) ! Formatting 100 format ( A , F0 . 4 , A , F0 . 4 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_overconstraint_error ( name , err ) !! Reports an overconstraint error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Report the error call err % report_error ( name , \"The model is overconstrained.\" , & DYN_CONSTRAINT_ERROR ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_array_index_out_of_bounds_error ( name , var , ind , sz , err ) !! Reports an array index-out-of-bounds error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: ind !! The offending index. integer ( int32 ), intent ( in ) :: sz !! The array size. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) & \"Index \" , ind , \" is outside the bounds of array \" // var // & \", which is of size \" , sz , \".\" call err % report_error ( name , trim ( errmsg ), DYN_INDEX_OUT_OF_RANGE ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonmonotonic_array_error ( name , var , ind , err ) !! Reports a nonmonotonic array error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: ind !! The index of the occurrence of nonmonotonicity. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Array \" // var // & \" was found to be nonmonotonic at index \" , ind , \".\" call err % report_error ( name , trim ( errmsg ), DYN_NONMONOTONIC_ARRAY_ERROR ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_constraint_count_error ( name , expected , actual , err ) !! Reports an error associated with an incorrect number of constraints. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: expected !! The expected number of constraints. integer ( int32 ), intent ( in ) :: actual !! The actual number of constraints. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Expected to find \" , expected , & \" constraints, but found \" , actual , \" constraints instead.\" call err % report_error ( name , trim ( errmsg ), DYN_CONSTRAINT_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_array_size_error ( name , var , expected , actual , err ) !! Reports an array size error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: expected !! The expected array size. integer ( int32 ), intent ( in ) :: actual !! The actual array size. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Expected array \" // var // \" to be of size \" , & expected , \", but found it to be of size \" , actual , \".\" call err % report_error ( name , trim ( errmsg ), DYN_ARRAY_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_matrix_size_error ( name , var , expect_rows , expect_cols , & actual_rows , actual_cols , err ) !! Reports a matrix size error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: expect_rows !! The expected number of rows. integer ( int32 ), intent ( in ) :: expect_cols !! The expected number of columns. integer ( int32 ), intent ( in ) :: actual_rows !! The actual number of rows. integer ( int32 ), intent ( in ) :: actual_cols !! The actual number of columns. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 512 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Expected matrix \" // var // \" to be of size (\" , & expect_rows , \"-by-\" , expect_cols , & \"), but found it to be of size (\" , actual_rows , \"-by-\" , & actual_cols , \").\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_convergence_error ( name , niter , resid , err ) !! Reports a convergence error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: niter !! The actual number of iterations taken. real ( real64 ), intent ( in ) :: resid !! The current residual estimate. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 512 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The iteration process failed to converge taking \" , & niter , \" iterations with the current residual of \" , resid , \".\" call err % report_error ( name , trim ( errmsg ), DYN_CONVERGENCE_ERROR ) ! Formatting 100 format ( A , I0 , A , E12 . 5 , A ) end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_error_handling.f90.html"},{"title":"dynamics_frequency_response.f90 – DYNAMICS","text":"Contents Modules dynamics_frequency_response Source Code dynamics_frequency_response.f90 Source Code module dynamics_frequency_response use iso_fortran_env use ferror use diffeq , only : ode_container , ode_integrator use dynamics_error_handling use spectrum use fstats implicit none private public :: ode_excite public :: modal_excite public :: harmonic_ode public :: frf public :: mimo_frf public :: chirp public :: frequency_response public :: frequency_sweep public :: compute_modal_damping public :: modal_response public :: normalize_mode_shapes public :: evaluate_accelerance_frf_model public :: evaluate_receptance_frf_model public :: fit_frf public :: FRF_ACCELERANCE_MODEL public :: FRF_RECEPTANCE_MODEL public :: regression_statistics public :: iteration_controls public :: lm_solver_options public :: convergence_info public :: ode_integrator interface function ode_excite ( t ) result ( rst ) !! Defines the interface for a ODE excitation function. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: t !! The value of the independent variable at which to evaluate !! the excitation function. real ( real64 ) :: rst !! The result. end function subroutine modal_excite ( freq , frc , args ) !! Defines the interface to a routine for defining the forcing !! function for a modal frequency analysis. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: freq !! The excitation frequency. When used as a part of a frequency !! response calculation, this value will have the same units as !! the frequency values provided to the frequency response !! routine. complex ( real64 ), intent ( out ), dimension (:) :: frc !! An N-element array where the forcing function should be !! written. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to communicate with !! the outside world. end subroutine subroutine harmonic_ode ( freq , t , x , dxdt , args ) !! Defines a system of ODE's exposed to harmonic excitation. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: freq !! The excitation frequency. real ( real64 ), intent ( in ) :: t !! The current time step value. real ( real64 ), intent ( in ), dimension (:) :: x !! The value of the solution estimate at time t. real ( real64 ), intent ( out ), dimension (:) :: dxdt !! The derivatives as computed by this routine. class ( * ), intent ( inout ), optional :: args !! An optional argument allowing the passing of data in/out of !! this routine. end subroutine end interface type frf !! A container for a frequency response function, or series of frequency !! response functions. real ( real64 ), allocatable , dimension (:) :: frequency !! An N-element array containing the frequency values at which the !! FRF is provided. The units of this array are the same as the !! units of the frequency values passed to the routine used to !! compute the frequency response. complex ( real64 ), allocatable , dimension (:,:) :: responses !! An N-by-M matrix containing the M frequency response functions !! evaluated at each of the N frequency points. end type type mimo_frf !! A container for the frequency responses of a system of multiple !! inputs and multiple outputs (MIMO). real ( real64 ), allocatable , dimension (:) :: frequency !! An N-element array containing the frequency values at which the !! FRF is provided. The units of this array are the same as the !! units of the frequency values passed to the routine used to !! compute the frequency response. complex ( real64 ), allocatable , dimension (:,:,:) :: responses !! An N-by-M-by-P array containing the frequency response functions !! for each of the M outputs corresponding to each of the P inputs. end type interface frequency_response !! Computes the frequency response functions for a system of ODE's. module procedure :: frf_modal_prop_damp module procedure :: frf_modal_prop_damp_2 module procedure :: siso_freqres module procedure :: mimo_freqres end interface interface frequency_sweep module procedure :: frf_sweep_1 module procedure :: frf_sweep_2 end interface interface evaluate_accelerance_frf_model module procedure :: evaluate_accelerance_frf_model_scalar module procedure :: evaluate_accelerance_frf_model_array end interface interface evaluate_receptance_frf_model module procedure :: evaluate_receptance_frf_model_scalar module procedure :: evaluate_receptance_frf_model_array end interface ! ------------------------------------------------------------------------------ integer ( int32 ), parameter :: FRF_ACCELERANCE_MODEL = 1 !! Defines an accelerance frequency response model. integer ( int32 ), parameter :: FRF_RECEPTANCE_MODEL = 2 !! Defines a receptance frequency response model. ! ------------------------------------------------------------------------------ type frf_arg_container procedure ( harmonic_ode ), pointer , nopass :: fcn real ( real64 ) :: frequency logical :: uses_optional_args class ( * ), allocatable :: optional_args end type contains ! ------------------------------------------------------------------------------ pure elemental function chirp ( t , amp , span , f1Hz , f2Hz ) result ( rst ) !! Evaluates a linear chirp function. real ( real64 ), intent ( in ) :: t !! The value of the independent variable at which to evaluate the !! chirp. real ( real64 ), intent ( in ) :: amp !! The amplitude. real ( real64 ), intent ( in ) :: span !! The duration of the time it takes to sweep from the start !! frequency to the end frequency. real ( real64 ), intent ( in ) :: f1Hz !! The lower excitation frequency, in Hz. real ( real64 ), intent ( in ) :: f2Hz !! The upper excitation frequency, in Hz. real ( real64 ) :: rst !! The value of the function at t. real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) real ( real64 ) :: c c = ( f2Hz - f1Hz ) / span rst = amp * sin ( 2.0d0 * pi * t * ( 0.5d0 * c * t + f1Hz )) end function ! ------------------------------------------------------------------------------ function frf_modal_prop_damp ( mass , stiff , alpha , beta , freq , frc , & modes , modeshapes , args , err ) result ( rst ) !! Computes the frequency response functions for a !! multi-degree-of-freedom system that uses proportional damping such !! that the damping matrix C is related to the stiffness an mass !! matrices by proportional damping coefficients \\alpha and !! \\beta by C = \\alpha M + \\beta K . use linalg , only : eigen , sort , mtx_mult , LA_NO_OPERATION , LA_TRANSPOSE use dynamics_error_handling real ( real64 ), intent ( in ), dimension (:,:) :: mass !! The N-by-N mass matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ), dimension (:,:) :: stiff !! The N-by-N stiffness matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ) :: alpha !! The mass damping factor, \\alpha . real ( real64 ), intent ( in ) :: beta !! The stiffness damping factor, \\beta . real ( real64 ), intent ( in ), dimension (:) :: freq !! An M-element array of frequency values at which to evaluate the !! frequency response functions, in units of rad/s. procedure ( modal_excite ), pointer , intent ( in ) :: frc !! A pointer to a routine used to compute the modal forcing !! function. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:) :: modes !! An optional N-element allocatable array that, if supplied, will !! be used to retrieve the modal frequencies, in units of rad/s. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:,:) :: modeshapes !! An optional N-by-N allocatable matrix that, if supplied, will be !! used to retrieve the N mode shapes with each vector occupying !! its own column. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to communicate with !! the outside world. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices !! are not square, or if the mass and stiffness matrices are !! different sized. !! - DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer !! is undefined. type ( frf ) :: rst !! The resulting frequency responses. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) complex ( real64 ), parameter :: zero = ( 0.0d0 , 0.0d0 ) complex ( real64 ), parameter :: one = ( 1.0d0 , 0.0d0 ) ! Local Variables integer ( int32 ) :: i , m , n , flag complex ( real64 ) :: s real ( real64 ), allocatable , dimension (:) :: lambda , zeta real ( real64 ), allocatable , dimension (:,:) :: mmtx , kmtx complex ( real64 ), allocatable , dimension (:) :: vals , q , f , u complex ( real64 ), allocatable , dimension (:,:) :: vecs class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if m = size ( freq ) n = size ( mass , 1 ) ! Input Checking if ( size ( mass , 2 ) /= n ) go to 20 if ( size ( stiff , 1 ) /= size ( stiff , 2 )) go to 30 if ( size ( stiff , 1 ) /= n . or . size ( stiff , 2 ) /= n ) go to 40 if (. not . associated ( frc )) go to 50 ! TO DO: Check for symmetry ! Memory allocations allocate ( mmtx ( n , n ), source = mass , stat = flag ) if ( flag == 0 ) allocate ( kmtx ( n , n ), source = stiff , stat = flag ) if ( flag == 0 ) allocate ( zeta ( n ), stat = flag ) if ( flag == 0 ) allocate ( q ( n ), stat = flag ) if ( flag == 0 ) allocate ( vals ( n ), stat = flag ) if ( flag == 0 ) allocate ( f ( n ), stat = flag , source = zero ) if ( flag == 0 ) allocate ( u ( n ), stat = flag ) if ( flag == 0 ) allocate ( vecs ( n , n ), stat = flag ) if ( flag == 0 ) allocate ( rst % responses ( m , n ), stat = flag ) if ( flag == 0 ) allocate ( rst % frequency ( m ), source = freq , stat = flag ) if ( flag /= 0 ) go to 10 ! Compute the eigenvalues and eigenvectors call eigen ( kmtx , mmtx , vals , vecs = vecs , err = errmgr ) if ( errmgr % has_error_occurred ()) return allocate ( lambda ( n ), source = real ( vals ), stat = flag ) if ( flag /= 0 ) go to 10 ! Compute the damping terms zeta = compute_modal_damping ( lambda , alpha , beta ) ! Compute each transfer function do i = 1 , m call frc ( freq ( i ), f , args ) call mtx_mult ( LA_TRANSPOSE , one , vecs , f , zero , u ) s = j * freq ( i ) q = u / ( s ** 2 + 2.0d0 * zeta * sqrt ( lambda ) * s + lambda ) call mtx_mult ( LA_NO_OPERATION , one , vecs , q , zero , rst % responses ( i ,:)) end do ! If needed, return the modal frequencies and mode shapes if ( present ( modes ) . or . present ( modeshapes )) then ! Sort the modal information call sort ( vals , vecs ) end if if ( present ( modes )) then allocate ( modes ( n ), source = sqrt ( real ( vals )), & stat = flag ) if ( flag /= 0 ) go to 10 end if if ( present ( modeshapes )) then allocate ( modeshapes ( n , n ), source = real ( vecs ), stat = flag ) if ( flag /= 0 ) go to 10 end if ! End return ! Memory error 10 continue call report_memory_error ( \"frf_modal_prop_damp\" , flag , errmgr ) return ! Error: Mass matrix is not square 20 continue call report_nonsquare_mass_matrix_error ( \"frf_modal_prop_damp\" , & size ( mass , 1 ), size ( mass , 2 ), errmgr ) return ! Error: Stiffness matrix is not square 30 continue call report_nonsquare_stiffness_matrix_error ( \"frf_modal_prop_damp\" , & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Error: Stiffness matrix is not sized correctly 40 continue call report_matrix_size_mismatch_error ( \"frf_modal_prop_damp\" , & \"mass\" , \"stiffness\" , size ( mass , 1 ), size ( mass , 2 ), & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Null forcing term pointer 50 continue call report_null_forcing_routine_error ( \"frf_modal_prop_damp\" , & errmgr ) return end function ! ------------------------------------------------------------------------------ function frf_modal_prop_damp_2 ( mass , stiff , alpha , beta , nfreq , freq1 , & freq2 , frc , modes , modeshapes , args , err ) result ( rst ) !! Computes the frequency response functions for a !! multi-degree-of-freedom system that uses proportional damping such !! that the damping matrix C is related to the stiffness an mass !! matrices by proportional damping coefficients \\alpha and !! \\beta by C = \\alpha M + \\beta K . use linalg , only : eigen , sort , mtx_mult , LA_NO_OPERATION , LA_TRANSPOSE use dynamics_error_handling real ( real64 ), intent ( in ), dimension (:,:) :: mass !! The N-by-N mass matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ), dimension (:,:) :: stiff !! The N-by-N stiffness matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ) :: alpha !! The mass damping factor, \\alpha . real ( real64 ), intent ( in ) :: beta !! The stiffness damping factor, \\beta . integer ( int32 ), intent ( in ) :: nfreq !! The number of frequency values to analyze. This value must be !! at least 2. real ( real64 ), intent ( in ) :: freq1 !! The starting frequency, in units of rad/s. real ( real64 ), intent ( in ) :: freq2 !! The ending frequency, in units of rad/s. procedure ( modal_excite ), pointer , intent ( in ) :: frc !! A pointer to a routine used to compute the modal forcing !! function. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:) :: modes !! An optional N-element allocatable array that, if supplied, will !! be used to retrieve the modal frequencies, in units of rad/s. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:,:) :: modeshapes !! An optional N-by-N allocatable matrix that, if supplied, will be !! used to retrieve the N mode shapes with each vector occupying !! its own column. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to communicate with !! the outside world. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices !! are not square, or if the mass and stiffness matrices are !! different sized. !! - DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer !! is undefined. type ( frf ) :: rst !! The resulting frequency responses. ! Local Variables integer ( int32 ) :: i , flag real ( real64 ) :: df real ( real64 ), allocatable , dimension (:) :: freq class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if ! Input Checking if ( abs ( freq1 - freq2 ) < sqrt ( epsilon ( freq1 ))) then call report_zero_difference_error ( \"frf_modal_prop_damp_2\" , & \"freq1\" , freq1 , \"freq2\" , freq2 , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if if ( nfreq < 2 ) then call report_generic_counting_error ( \"frf_modal_prop_damp_2\" , & \"The number of frequency points must be at least 2, \" // & \"but was found to be \" , nfreq , \".\" , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if ! Process df = ( freq2 - freq1 ) / ( nfreq - 1.0d0 ) allocate ( freq ( nfreq ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"frf_modal_prop_damp_2\" , flag , errmgr ) return end if freq = ( / ( df * i + freq1 , i = 0 , nfreq - 1 ) / ) rst = frequency_response ( mass , stiff , alpha , beta , freq , frc , modes , & modeshapes , args = args , err = err ) end function ! ------------------------------------------------------------------------------ pure elemental function compute_modal_damping ( lambda , alpha , beta ) & result ( rst ) !! Computes the modal damping factors \\zeta_i given the !! proportional damping terms \\alpha and \\beta where !! \\alpha + \\beta \\omega_{i}^2 = 2 \\zeta_{i} \\omega_{i} , !! \\lambda_{i} = \\omega_{i}^2 , and \\lambda_i is the !! i^{th} eigenvalue of the system. real ( real64 ), intent ( in ) :: lambda !! The square of the modal frequency - the eigen value. real ( real64 ), intent ( in ) :: alpha !! The mass damping factor, \\alpha . real ( real64 ), intent ( in ) :: beta !! The stiffness damping factor, \\beta . real ( real64 ) rst !! The modal damping parameter. ! Local Variables integer ( int32 ) :: n ! Process rst = ( alpha + beta * lambda ) / ( 2.0d0 * sqrt ( lambda )) end function ! ------------------------------------------------------------------------------ subroutine modal_response ( mass , stiff , freqs , modeshapes , err ) !! Computes the modal frequencies and modes shapes for !! multi-degree-of-freedom system. use dynamics_error_handling use linalg , only : eigen , sort real ( real64 ), intent ( in ), dimension (:,:) :: mass !! The N-by-N mass matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ), dimension (:,:) :: stiff !! The N-by-N stiffness matrix for the system. This matrix must !! be symmetric. real ( real64 ), intent ( out ), allocatable , dimension (:) :: freqs !! An allocatable N-element array where the modal frequencies will !! be returned in ascending order with units of rad/s. real ( real64 ), intent ( out ), allocatable , optional , dimension (:,:) :: & modeshapes !! An optional, allocatable N-by-N matrix where the N mode shapes !! for the system will be returned. The mode shapes are stored in !! columns. class ( errors ), intent ( inout ), optional , target :: err ! Local Variables integer ( int32 ) :: n , flag real ( real64 ), allocatable , dimension (:,:) :: mmtx , kmtx complex ( real64 ), allocatable , dimension (:) :: vals complex ( real64 ), allocatable , dimension (:,:) :: vecs class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( mass , 1 ) ! Input Checking if ( size ( mass , 2 ) /= n ) go to 10 if ( size ( stiff , 1 ) /= size ( stiff , 2 )) go to 20 if ( size ( stiff , 1 ) /= n . or . size ( stiff , 2 ) /= n ) go to 30 ! TO DO: Check for symmetry ! Memory allocations allocate ( mmtx ( n , n ), source = mass , stat = flag ) if ( flag == 0 ) allocate ( kmtx ( n , n ), source = stiff , stat = flag ) if ( flag == 0 ) allocate ( vals ( n ), stat = flag ) if ( flag == 0 . and . present ( modeshapes )) & allocate ( vecs ( n , n ), stat = flag ) if ( flag /= 0 ) go to 40 ! Solve the eigen problem if ( present ( modeshapes )) then call eigen ( kmtx , mmtx , vals , vecs = vecs , err = errmgr ) if ( errmgr % has_error_occurred ()) return call sort ( vals , vecs ) allocate ( modeshapes ( n , n ), source = real ( vecs ), stat = flag ) if ( flag /= 0 ) go to 40 else call eigen ( kmtx , mmtx , vals , err = errmgr ) if ( errmgr % has_error_occurred ()) return call sort ( vals ) end if ! Convert the eigenvalues to frequency values allocate ( freqs ( n ), source = sqrt ( abs ( real ( vals ))), & stat = flag ) if ( flag /= 0 ) go to 40 ! End return ! Non-square mass matrix error handler 10 continue call report_nonsquare_mass_matrix_error ( \"modal_response\" , & size ( mass , 1 ), size ( mass , 2 ), errmgr ) return ! Non-square stiffness matrix error handler 20 continue call report_nonsquare_stiffness_matrix_error ( \"modal_response\" , & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Stiffness and mass matrix size mismatch error handler 30 continue call report_matrix_size_mismatch_error ( \"modal_response\" , & \"mass\" , \"stiffness\" , size ( mass , 1 ), size ( mass , 2 ), & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Memory error handler 40 continue call report_memory_error ( \"modal_response\" , flag , errmgr ) return end subroutine ! ------------------------------------------------------------------------------ subroutine normalize_mode_shapes ( x ) !! Normalizes mode shape vectors such that the largest magnitude !! value in the vector is one. real ( real64 ), intent ( inout ), dimension (:,:) :: x !! The matrix of mode shape vectors with one vector per column. ! Local Variables integer ( int32 ) :: i , loc real ( real64 ) :: factor ! Process do i = 1 , size ( x , 2 ) loc = maxloc ( abs ( x (:, i )), 1 ) factor = x ( loc , i ) x (:, i ) = x (:, i ) / factor end do end subroutine ! ****************************************************************************** ! HARMONIC_ODE_CONTAINER ROUTINES ! ------------------------------------------------------------------------------ function frf_sweep_1 ( fcn , freq , iv , solver , ncycles , ntransient , & points , args , err ) result ( rst ) !! Computes the frequency response of each equation of a system of !! harmonically excited ODE's by sweeping through frequency. use spectrum , only : next_power_of_two use fftpack , only : zffti use diffeq , only : runge_kutta_45 use dynamics_error_handling procedure ( harmonic_ode ), pointer , intent ( in ) :: fcn !! A pointer to the routine containing the ODE's to integrate. real ( real64 ), intent ( in ), dimension (:) :: freq !! An M-element array containing the frequency points at which the !! solution should be computed. Notice, whatever units are utilized !! for this array are also the units of the excitation_frequency !! property in @p sys. It is recommended that the units be set to !! Hz. Additionally, this array cannot contain any zero-valued !! elements as the ODE solution time for each frequency is !! determined by the period of oscillation and number of cycles. real ( real64 ), intent ( in ), dimension (:) :: iv !! An N-element array containing the initial conditions for each of !! the N ODEs. class ( ode_integrator ), intent ( inout ), optional , target :: solver !! An optional differential equation solver. The default solver !! is the Dormand-Prince Runge-Kutta integrator from the DIFFEQ !! library. integer ( int32 ), intent ( in ), optional :: ncycles !! An optional parameter controlling the number of cycles to !! analyze when determining the amplitude and phase of the response. !! The default is 20. integer ( int32 ), intent ( in ), optional :: ntransient !! An optional parameter controlling how many of the initial !! \"transient\" cycles to ignore. The default is 200. integer ( int32 ), intent ( in ), optional :: points !! An optional parameter controlling how many evenly spaced !! solution points should be considered per cycle. The default is !! 1000. Notice, there must be at least 2 points per cycle for the !! analysis to be effective. The algorithm utilizes a discrete !! Fourier transform to determine the phase and amplitude, and in !! order to satisfy Nyquist conditions, the value must be at least !! 2. class ( * ), intent ( inout ), optional :: args !! An optional argument allowing for passing of data in/out of the !! fcn subroutine. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. !! - DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter !! is given. !! - DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued !! frequency was supplied. type ( frf ) :: rst !! The resulting frequency responses. ! Parameters real ( real64 ), parameter :: zerotol = sqrt ( epsilon ( 0.0d0 )) ! Local Variables integer ( int32 ) :: i , j , nfreq , neqn , nc , nt , ntotal , npts , ppc , flag , & nfft , i1 , ncpts , lsave real ( real64 ) :: dt , tare , phase , amp real ( real64 ), allocatable , dimension (:) :: ic , t , wsave real ( real64 ), allocatable , dimension (:,:) :: sol complex ( real64 ), allocatable , dimension (:) :: xpts type ( ode_container ) :: sys class ( ode_integrator ), pointer :: integrator type ( runge_kutta_45 ), target :: default_integrator class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( frf_arg_container ) :: container ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if if ( present ( ncycles )) then nc = ncycles else nc = 20 end if if ( present ( ntransient )) then nt = ntransient else nt = 200 end if if ( present ( points )) then ppc = points else ppc = 1000 end if nfreq = size ( freq ) neqn = size ( iv ) ntotal = nt + nc npts = ntotal * ppc ncpts = nc * ppc i1 = npts - ncpts + 1 nfft = 2 ** next_power_of_two ( ppc * nc ) lsave = 4 * nfft + 15 sys % fcn => sweep_eom ! Set up the optional argument container container % fcn => fcn container % uses_optional_args = present ( args ) if ( present ( args )) then allocate ( container % optional_args , source = args ) end if ! Set up the integrator if ( present ( solver )) then integrator => solver else integrator => default_integrator end if ! Input Checking if ( nc < 1 ) go to 20 if ( nt < 1 ) go to 30 if ( ppc < 2 ) go to 40 do i = 1 , nfreq if ( abs ( freq ( i )) < zerotol ) go to 50 end do ! Local Memory Allocation allocate ( rst % responses ( nfreq , neqn ), stat = flag ) if ( flag == 0 ) allocate ( rst % frequency ( nfreq ), source = freq , & stat = flag ) if ( flag == 0 ) allocate ( ic ( neqn ), stat = flag , source = iv ) if ( flag == 0 ) allocate ( t ( npts ), stat = flag ) if ( flag == 0 ) allocate ( xpts ( nfft ), stat = flag , source = ( 0.0d0 , 0.0d0 )) if ( flag == 0 ) allocate ( wsave ( lsave ), stat = flag ) if ( flag /= 0 ) go to 10 ! Set up the FFT calculations for the get_magnitude_phase routine call zffti ( nfft , wsave ) ! Cycle over each frequency point do i = 1 , nfreq ! Define the time vector dt = ( 1.0d0 / freq ( i )) / ( ppc - 1.0d0 ) t = ( / ( dt * j , j = 0 , npts - 1 ) / ) ! Set the frequency container % frequency = freq ( i ) ! Compute the solution call integrator % solve ( sys , t , ic , args = container , err = errmgr ) if ( errmgr % has_error_occurred ()) return sol = integrator % get_solution () ! Reset the initial conditions to the last solution point ic = sol ( npts , 2 :) ! Determine the magnitude and phase for each equation do j = 1 , neqn rst % responses ( i , j ) = & get_magnitude_phase ( sol ( i1 : npts , j + 1 ), xpts , wsave ) end do ! Clear the solution buffer for the next time around call integrator % clear_buffer () end do ! End return ! Memory Error 10 continue call report_memory_error ( \"frf_sweep_1\" , flag , errmgr ) return ! Number of Cycles Error 20 continue call report_generic_counting_error ( \"frf_sweep_1\" , & \"The number of cycles to analyze must be at least 1; \" // & \"however, a value of \" , nc , \" was found.\" , & DYN_INVALID_INPUT_ERROR , errmgr ) return ! Number of Transient Cycles Error 30 continue call report_generic_counting_error ( \"frf_sweep_1\" , & \"The number of transient cycles must be at least 1; \" // & \"however, a value of \" , nt , \" was found.\" , & DYN_INVALID_INPUT_ERROR , errmgr ) return ! Points Per Cycle Error 40 continue call report_generic_counting_error ( \"frf_sweep_1\" , & \"The number of points per cycle must be at least 2; \" // & \"however, a value of \" , ppc , \" was found.\" , & DYN_INVALID_INPUT_ERROR , errmgr ) return ! Zero-Valued Frequency Error 50 continue call report_zero_valued_frequency_error ( \"frf_sweep_1\" , i , errmgr ) return end function ! ---------- subroutine sweep_eom ( x , y , dydx , args ) real ( real64 ), intent ( in ) :: x real ( real64 ), intent ( in ), dimension (:) :: y real ( real64 ), intent ( out ), dimension (:) :: dydx class ( * ), intent ( inout ), optional :: args select type ( args ) class is ( frf_arg_container ) if ( args % uses_optional_args ) then call args % fcn ( args % frequency , x , y , dydx , args % optional_args ) else call args % fcn ( args % frequency , x , y , dydx ) end if end select end subroutine ! ---------- function get_magnitude_phase ( x , xzeros , wsave ) result ( rst ) !! Returns the magnitude and phase of a signal. use fftpack , only : zfftf use spectrum , only : compute_transform_length ! Arguments real ( real64 ), intent ( in ), dimension (:) :: x !! The array containing the signal. complex ( real64 ), intent ( out ), dimension (:) :: xzeros !! A workspace array for the FFT operation. real ( real64 ), intent ( in ), dimension (:) :: wsave !! A workspace array for the FFT operation complex ( real64 ) :: rst !! The complex-valued result defining both magnitude and phase. ! Parameters complex ( real64 ), parameter :: czero = ( 0.0d0 , 0.0d0 ) ! Local Variables integer ( int32 ) :: i , ind , m , n , nx ! Initialization nx = size ( x ) n = size ( xzeros ) m = compute_transform_length ( n ) ! Zero pad the data xzeros (: nx ) = cmplx ( x , 0.0d0 , real64 ) xzeros ( nx + 1 :) = czero ! Compute the FFT to estimate the phase call zfftf ( n , xzeros , wsave ) ind = maxloc ( abs ( xzeros ( 2 : m )), 1 ) + 1 ! start at 2 to avoid any DC issues rst = 2.0d0 * xzeros ( ind ) / nx end function ! ------------------------------------------------------------------------------ function frf_sweep_2 ( fcn , nfreq , freq1 , freq2 , iv , solver , ncycles , & ntransient , points , args , err ) result ( rst ) !! Computes the frequency response of each equation of a system of !! harmonically excited ODE's by sweeping through frequency. use spectrum , only : next_power_of_two use diffeq , only : runge_kutta_45 use dynamics_error_handling procedure ( harmonic_ode ), pointer , intent ( in ) :: fcn !! A pointer to the routine containing the ODE's to integrate. integer ( int32 ), intent ( in ) :: nfreq !! The number of frequency values to analyze. This value must be !! at least 2. real ( real64 ), intent ( in ) :: freq1 !! The starting frequency. It is recommended that the units be set !! to Hz. real ( real64 ), intent ( in ) :: freq2 !! The ending frequency. It is recommended that the units be set to !! Hz. real ( real64 ), intent ( in ), dimension (:) :: iv !! An N-element array containing the initial conditions for each of !! the N ODEs. class ( ode_integrator ), intent ( inout ), optional , target :: solver !! An optional differential equation solver. The default solver !! is the Dormand-Prince Runge-Kutta integrator from the DIFFEQ !! library. integer ( int32 ), intent ( in ), optional :: ncycles !! An optional parameter controlling the number of cycles to !! analyze when determining the amplitude and phase of the response. !! The default is 20. integer ( int32 ), intent ( in ), optional :: ntransient !! An optional parameter controlling how many of the initial !! \"transient\" cycles to ignore. The default is 200. integer ( int32 ), intent ( in ), optional :: points !! An optional parameter controlling how many evenly spaced !! solution points should be considered per cycle. The default is !! 1000. Notice, there must be at least 2 points per cycle for the !! analysis to be effective. The algorithm utilizes a discrete !! Fourier transform to determine the phase and amplitude, and in !! order to satisfy Nyquist conditions, the value must be at least !! 2. class ( * ), intent ( inout ), optional :: args !! An optional argument allowing for passing of data in/out of the !! fcn subroutine. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. !! - DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter !! is given. !! - DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued !! frequency was supplied. type ( frf ) :: rst !! The resulting frequency responses. ! Local Variables integer ( int32 ) :: i , flag real ( real64 ) :: df real ( real64 ), allocatable , dimension (:) :: freq class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if ! Input Checking if ( abs ( freq1 - freq2 ) < sqrt ( epsilon ( freq1 ))) then call report_zero_difference_error ( \"hoc_frf_sweep_2\" , & \"freq1\" , freq1 , \"freq2\" , freq2 , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if if ( nfreq < 2 ) then call report_generic_counting_error ( \"hoc_frf_sweep_2\" , & \"The number of frequency points must be at least 2, \" // & \"but was found to be \" , nfreq , \".\" , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if ! Process df = ( freq2 - freq1 ) / ( nfreq - 1.0d0 ) allocate ( freq ( nfreq ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"hoc_frf_sweep_2\" , flag , errmgr ) return end if freq = ( / ( df * i + freq1 , i = 0 , nfreq - 1 ) / ) rst = frf_sweep_1 ( fcn , freq , iv , solver , ncycles , ntransient , & points , args = args , err = err ) end function ! ****************************************************************************** ! VERSION 1.0.5 ADDITIONS ! ------------------------------------------------------------------------------ function siso_freqres ( x , y , fs , win , method , err ) result ( rst ) !! Estimates the frequency response of a single-input, single-output (SISO) !! system. real ( real64 ), intent ( in ), dimension (:) :: x !! An N-element array containing the excitation signal. real ( real64 ), intent ( in ), dimension (:) :: y !! An N-element array containing the response signal. real ( real64 ), intent ( in ) :: fs !! The sampling frequency, in Hz. class ( window ), intent ( in ), optional , target :: win !! The window to apply to the data. If nothing is supplied, no window !! is applied. integer ( int32 ), intent ( in ), optional :: method !! Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an !! H2 estimator. The default is an H1 estimator. !! !! An H1 estimator is defined as the cross-spectrum of the input and !! response signals divided by the energy spectral density of the input. !! An H2 estimator is defined as the energy spectral density of the !! response divided by the cross-spectrum of the input and response !! signals. !! !! H_{1} = \\frac{P_{xy}}{P_{xx}} !! !! H_{2} = \\frac{P_{yy}}{P_{xy}} class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! !! - DYN_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size. type ( frf ) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , npts , nfreq , meth , flag real ( real64 ) :: df class ( window ), pointer :: wptr type ( rectangular_window ), target :: defwin class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if npts = size ( x ) if ( present ( win )) then wptr => win else defwin % size = npts wptr => defwin end if if ( present ( method )) then if ( method == 2 ) then meth = SPCTRM_H2_ESTIMATOR else meth = SPCTRM_H1_ESTIMATOR end if else meth = SPCTRM_H1_ESTIMATOR end if nfreq = compute_transform_length ( wptr % size ) allocate ( rst % frequency ( nfreq ), stat = flag ) if ( flag == 0 ) allocate ( rst % responses ( nfreq , 1 ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"siso_freqres\" , flag , errmgr ) return end if ! Input Checking if ( size ( y ) /= npts ) then call report_array_size_error ( \"siso_freqres\" , \"y\" , npts , size ( y ), errmgr ) return end if ! Compute the transfer function rst % responses (:, 1 ) = siso_transfer_function ( wptr , x , y , etype = meth ) ! Compute the frequency vector df = frequency_bin_width ( fs , wptr % size ) rst % frequency = ( / ( df * i , i = 0 , nfreq - 1 ) / ) end function ! ------------------------------------------------------------------------------ function mimo_freqres ( x , y , fs , win , method , err ) result ( rst ) !! Estimates the frequency responses of a multiple-input, multiple-output !! (MIMO) system. real ( real64 ), intent ( in ), dimension (:,:) :: x !! An N-by-P array containing the P inputs to the system. real ( real64 ), intent ( in ), dimension (:,:) :: y !! An N-by-M array containing the M outputs from the system. real ( real64 ), intent ( in ) :: fs !! The sampling frequency, in Hz. class ( window ), intent ( in ), optional , target :: win !! The window to apply to the data. If nothing is supplied, no window !! is applied. integer ( int32 ), intent ( in ), optional :: method !! Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an !! H2 estimator. The default is an H1 estimator. !! !! An H1 estimator is defined as the cross-spectrum of the input and !! response signals divided by the energy spectral density of the input. !! An H2 estimator is defined as the energy spectral density of the !! response divided by the cross-spectrum of the input and response !! signals. !! !! H_{1} = \\frac{P_{xy}}{P_{xx}} !! !! H_{2} = \\frac{P_{yy}}{P_{xy}} class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! !! - DYN_ARRAY_SIZE_ERROR: Occurs if x and y do not have the same number !! of rows. type ( mimo_frf ) :: rst !! The resulting frequency response functions. ! Local Variables integer ( int32 ) :: i , j , npts , m , p , nfreq , meth , flag real ( real64 ) :: df class ( window ), pointer :: wptr type ( rectangular_window ), target :: defwin class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if npts = size ( x , 1 ) m = size ( y , 2 ) p = size ( x , 2 ) if ( present ( win )) then wptr => win else defwin % size = npts wptr => defwin end if if ( present ( method )) then if ( method == 2 ) then meth = SPCTRM_H2_ESTIMATOR else meth = SPCTRM_H1_ESTIMATOR end if else meth = SPCTRM_H1_ESTIMATOR end if nfreq = compute_transform_length ( wptr % size ) allocate ( rst % frequency ( nfreq ), stat = flag ) if ( flag == 0 ) allocate ( rst % responses ( nfreq , m , p )) if ( flag /= 0 ) then call report_memory_error ( \"mimo_freqres\" , flag , errmgr ) return end if ! Input Checking if ( size ( y , 1 ) /= npts ) then call report_matrix_size_error ( \"mimo_freqres\" , \"y\" , npts , size ( y , 2 ), & size ( y , 1 ), size ( y , 2 ), errmgr ) return end if ! Compute the transfer functions for each possible combination do j = 1 , p do i = 1 , m rst % responses (:, i , j ) = siso_transfer_function ( wptr , & x (:, j ), y (:, i ), etype = meth ) end do end do ! Compute the frequency vector df = frequency_bin_width ( fs , wptr % size ) rst % frequency = ( / ( df * i , i = 0 , nfreq - 1 ) / ) end function ! ****************************************************************************** ! V1.0.6 ADDITIONS ! ------------------------------------------------------------------------------ ! SEE: https://www.researchgate.net/publication/224619803_Reduction_of_structure-borne_noise_in_automobiles_by_multivariable_feedback subroutine frf_accel_fit_fcn ( xdata , mdl , rst , stop , args ) !! The FRF fitting function for an accelerance FRF (acceleration-excited). real ( real64 ), intent ( in ), dimension (:) :: xdata !! The independent variable data. real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameters. real ( real64 ), intent ( out ), dimension (:) :: rst !! The model results. logical , intent ( out ) :: stop !! Stop the simulation? class ( * ), intent ( inout ), optional :: args !! Optional arguments from the calling code. ! Local Variables integer ( int32 ) :: i , n complex ( real64 ) :: h ! Process: ! ! The amplitude portion of the response is stored in the first \"N\" locations ! in the output with the phase portion (in radians) is stored in the ! second \"N\" locations. n = size ( xdata ) / 2 do i = 1 , n h = evaluate_accelerance_frf_model ( mdl , xdata ( i )) rst ( i ) = abs ( h ) rst ( i + n ) = atan2 ( aimag ( h ), real ( h )) end do end subroutine ! ------------------------------------------------------------------------------ subroutine frf_force_fit_fcn ( xdata , mdl , rst , stop , args ) !! The FRF fitting function for an force-excited FRF. real ( real64 ), intent ( in ), dimension (:) :: xdata !! The independent variable data. real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameters. real ( real64 ), intent ( out ), dimension (:) :: rst !! The model results. logical , intent ( out ) :: stop !! Stop the simulation? class ( * ), intent ( inout ), optional :: args !! Optional arguments from the calling code. ! Local Variables integer ( int32 ) :: i , n complex ( real64 ) :: h ! Process: ! ! The amplitude portion of the response is stored in the first \"N\" locations ! in the output with the phase portion (in radians) is stored in the ! second \"N\" locations. n = size ( xdata ) / 2 do i = 1 , n h = evaluate_receptance_frf_model ( mdl , xdata ( i )) rst ( i ) = abs ( h ) rst ( i + n ) = atan2 ( aimag ( h ), real ( h )) end do end subroutine ! ------------------------------------------------------------------------------ function fit_frf ( mt , n , freq , rsp , maxp , minp , init , stats , alpha , controls , & settings , info , err ) result ( rst ) use peaks !! Fits an experimentally obtained frequency response by model for either a !! receptance model: !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{A_{i}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} !! !! or an accelerance model: !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{-A_{i} \\omega^{2}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} . !! !! Internally, the code uses a Levenberg-Marquardt solver to determine the !! parameters. The initial guess for the solver is determined by a !! peak finding algorithm used to locate the resonant modes in frequency. !! from this result, estimates for both the amplitude and natural frequency !! values are obtained. The damping parameters are assumed to be equal !! for all modes and set to a default value of 0.1. integer ( int32 ), intent ( in ) :: mt !! The excitation method. The options are as follows. !! !! - FRF_ACCELERANCE_MODEL: Use an accelerance model. !! !! - FRF_RECEPTANCE_MODEL: Use a receptance model. integer ( int32 ), intent ( in ) :: n !! The model order (# of resonant modes). real ( real64 ), intent ( in ), dimension (:) :: freq !! An M-element array containing the excitation frequency values in !! units of rad/s. complex ( real64 ), intent ( in ), dimension (:) :: rsp !! An M-element array containing the frequency response to fit. real ( real64 ), intent ( in ), dimension (:), optional :: maxp !! An optional 3*N-element array that can be used as upper limits on !! the parameter values. If no upper limit is requested for a particular !! parameter, utilize a very large value. The internal default is to !! utilize huge() as a value. real ( real64 ), intent ( in ), dimension (:), optional :: minp !! An optional 3*N-element array that can be used as lower limits on !! the parameter values. If no lower limit is requested for a particalar !! parameter, utilize a very large magnitude, but negative, value. The !! internal default is to utilize -huge() as a value. real ( real64 ), intent ( in ), dimension (:), optional :: init !! An optional 3*N-element array that, if supplied, provides an initial !! guess for each of the 3*N model parameters for the iterative solver. !! If supplied, this array replaces the peak finding algorithm for !! estimating an initial guess. type ( regression_statistics ), intent ( out ), dimension (:), optional :: stats !! An optional 3*N-element array that, if supplied, will be used to !! return statistics about the fit for each model parameter. real ( real64 ), intent ( in ), optional :: alpha !! The significance level at which to evaluate the confidence intervals. !! The default value is 0.05 such that a 95% confidence interval is !! calculated. type ( iteration_controls ), intent ( in ), optional :: controls !! An optional input providing custom iteration controls. type ( lm_solver_options ), intent ( in ), optional :: settings !! An optional input providing custom settings for the solver. type ( convergence_info ), intent ( out ), optional :: info !! An optional output that can be used to gain information about the !! iterative solution and the nature of the convergence. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! !! - DYN_ARRAY_SIZE_ERROR: Occurs if freq and rsp are not the same size. !! !! - DYN_UNDERDEFINED_PROBLEM_EROR: Occurs if the requested model !! order is too high for the number of data points available. !! !! - DYN_TOLERANCE_TOO_SMALL_ERROR: Occurs if the requested solver !! tolerance is too small to be practical for this problem. !! !! - DYN_TOO_FEW_ITERATIONS_ERROR: Occurs if convergence cannot be !! achieved in the allowed number of solver iterations. real ( real64 ), allocatable , dimension (:) :: rst !! An array containing the model parameters stored as \\left[ A_{1}, !! \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, \\zeta_{2} ... \\right] . ! Parameters real ( real64 ), parameter :: zeta = 0.1d0 ! Local Variables class ( errors ), pointer :: errmgr type ( errors ), target :: deferr procedure ( regression_function ), pointer :: fcn integer ( int32 ) :: i , npts , nparam , flag integer ( int32 ), allocatable , dimension (:) :: maxinds , mininds real ( real64 ) :: maxamp , minamp , amprange , delta real ( real64 ), allocatable , dimension (:) :: x , y , maxvals , minvals , & ymod , resid ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if select case ( mt ) case ( FRF_ACCELERANCE_MODEL ) fcn => frf_accel_fit_fcn case ( FRF_RECEPTANCE_MODEL ) fcn => frf_force_fit_fcn case default call errmgr % report_error ( \"fit_frf\" , \"Invalid entry for the \" // & \"variable mt. Must be either FRF_ACCELERANCE_MODEL or \" // & \"FRF_RECEPTANCE_MODEL.\" , DYN_INVALID_INPUT_ERROR ) return end select npts = size ( freq ) nparam = 3 * n ! Input Checking if ( size ( rsp ) /= npts ) then call report_array_size_error ( \"fit_frf\" , \"rsp\" , npts , size ( rsp ), errmgr ) return end if ! Memory Allocations allocate ( rst ( nparam ), stat = flag ) if ( flag == 0 ) allocate ( & x ( 2 * npts ), & y ( 2 * npts ), & ymod ( 2 * npts ), & resid ( 2 * npts ), & stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"fit_frf\" , flag , errmgr ) return end if ! Determine phase and amplitude terms, and store frequency values do i = 1 , npts ! Store frequency values x ( i ) = freq ( i ) x ( i + npts ) = freq ( i ) ! Store amplitude and phase values y ( i ) = abs ( rsp ( i )) y ( i + npts ) = atan2 ( aimag ( rsp ( i )), real ( rsp ( i ))) ! Determine max and min amplitudes if ( i == 1 ) then maxamp = y ( i ) minamp = y ( i ) else if ( y ( i ) > maxamp ) maxamp = y ( i ) if ( y ( i ) < minamp ) minamp = y ( i ) end if end do amprange = maxamp - minamp if ( present ( init )) then ! Check the array size if ( size ( init ) /= nparam ) then call report_array_size_error ( \"fit_frf\" , \"init\" , nparam , & size ( init ), errmgr ) return end if ! Copy init to rst rst = init else ! Perform the peak location to determine an initial guess at parameters delta = 0.005d0 * amprange call peak_detect ( y ( 1 : npts ), delta , maxinds , maxvals , mininds , minvals ) do i = 1 , min ( n , size ( maxvals )) rst ( 3 * i - 2 ) = maxvals ( i ) ! amplitude rst ( 3 * i - 1 ) = freq ( maxinds ( i )) ! frequency rst ( 3 * i ) = zeta ! damping end do if ( size ( maxvals ) < n ) then ! The peak detection did not find enough peaks. if ( size ( maxvals ) == 0 ) then ! No peaks found. This is suspicious, but just use a random ! estimate to get started. Maybe the solver will be able ! to sort it out. call random_number ( rst ) else ! Fill in the remaining parameters with the last set estimate do i = size ( maxvals ) + 1 , n rst ( 3 * i - 2 ) = rst ( 3 * ( i - 1 ) - 2 ) rst ( 3 * i - 1 ) = rst ( 3 * ( i - 1 ) - 1 ) rst ( 3 * i ) = rst ( 3 * ( i - 1 )) end do end if end if end if ! Fit the model call nonlinear_least_squares ( fcn , x , y , rst , ymod , resid , maxp = maxp , & minp = minp , stats = stats , alpha = alpha , controls = controls , & settings = settings , info = info , err = errmgr ) end function ! ------------------------------------------------------------------------------ pure function evaluate_accelerance_frf_model_scalar ( mdl , w ) result ( rst ) !! Evaluates the specified accelerance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{-A_{i} \\omega^{2}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , j , n ! Process j = 1 n = size ( mdl ) / 3 rst = ( 0.0d0 , 0.0d0 ) do i = 1 , n rst = rst + frf_accel_model_driver ( mdl ( j ), mdl ( j + 1 ), mdl ( j + 2 ), w ) j = j + 3 end do end function ! ---------- pure function evaluate_accelerance_frf_model_array ( mdl , w ) result ( rst ) !! Evaluates the specified accelerance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{-A_{i} \\omega^{2}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ), dimension (:) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ), allocatable , dimension (:) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , n ! Process n = size ( w ) allocate ( rst ( n )) do i = 1 , n rst ( i ) = evaluate_accelerance_frf_model_scalar ( mdl , w ( i )) end do end function ! ---------- pure elemental function frf_accel_model_driver ( A , wn , zeta , w ) result ( rst ) !! Evaluates a single term of the accelerance FRF model. real ( real64 ), intent ( in ) :: A !! The amplitude term. real ( real64 ), intent ( in ) :: wn !! The natural frequency term. real ( real64 ), intent ( in ) :: zeta !! The damping ratio term. real ( real64 ), intent ( in ) :: w !! The excitation frequency. complex ( real64 ) :: rst !! The result. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) ! Process rst = - A * w ** 2 / ( wn ** 2 - w ** 2 + 2.0d0 * j * zeta * wn * w ) end function ! ------------------------------------------------------------------------------ pure function evaluate_receptance_frf_model_scalar ( mdl , w ) result ( rst ) !! Evaluates the specified receptance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{A_{i}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , j , n ! Process j = 1 n = size ( mdl ) / 3 rst = ( 0.0d0 , 0.0d0 ) do i = 1 , n rst = rst + frf_receptance_model_driver ( mdl ( j ), mdl ( j + 1 ), mdl ( j + 2 ), w ) j = j + 3 end do end function ! ---------- pure function evaluate_receptance_frf_model_array ( mdl , w ) result ( rst ) !! Evaluates the specified receptance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{A_{i}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ), dimension (:) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ), allocatable , dimension (:) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , n ! Process n = size ( w ) allocate ( rst ( n )) do i = 1 , n rst ( i ) = evaluate_receptance_frf_model_scalar ( mdl , w ( i )) end do end function ! ---------- pure elemental function frf_receptance_model_driver ( A , wn , zeta , w ) result ( rst ) !! Evaluates a single term of the receptance FRF model. real ( real64 ), intent ( in ) :: A !! The amplitude term. real ( real64 ), intent ( in ) :: wn !! The natural frequency term. real ( real64 ), intent ( in ) :: zeta !! The damping ratio term. real ( real64 ), intent ( in ) :: w !! The excitation frequency. complex ( real64 ) :: rst !! The result. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) ! Process rst = A / ( wn ** 2 - w ** 2 + 2.0d0 * j * zeta * wn * w ) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_frequency_response.f90.html"},{"title":"dynamics_geometry.f90 – DYNAMICS","text":"Contents Modules dynamics_geometry Source Code dynamics_geometry.f90 Source Code module dynamics_geometry use iso_fortran_env use dynamics_helper use ieee_arithmetic use lapack , only : DGESVD , DGELSY use fstats , only : mean implicit none private public :: plane public :: plane_normal public :: line public :: plucker_line public :: assignment ( = ) public :: is_parallel public :: is_point_on_plane public :: is_point_on_line public :: nearest_point_on_line public :: point_to_line_distance public :: point_to_plane_distance public :: vector_plane_projection public :: point_plane_projection public :: matmul public :: line_from_point_and_vector public :: line_common_normal public :: do_lines_intersect type :: plane !! Defines a plane as a x + b y + c z + d = 0 . real ( real64 ) :: a !! The x-component of the plane normal vector. real ( real64 ) :: b !! The y-component of the plane normal vector. real ( real64 ) :: c !! The z-component of the plane normal vector. real ( real64 ) :: d !! The offset from the origin. contains procedure , public :: flip_normal => plane_flip_normal end type interface plane module procedure :: plane_from_3pts module procedure :: plane_from_point_and_normal module procedure :: plane_from_many_points end interface type :: line !! Defines the parametric form of a line !! \\vec{r} = \\vec{r_o} + t \\vec{v} . real ( real64 ) :: r0 ( 3 ) !! The coordinates of the initial point \\vec{r_o}. real ( real64 ) :: v ( 3 ) !! The vector defining the orientation of the line. contains procedure , public :: evaluate => line_eval end type interface line module procedure :: line_from_2pts module procedure :: line_from_2_planes module procedure :: line_from_many_points end interface interface assignment ( = ) module procedure :: plane_assign module procedure :: line_assign module procedure :: pl_assign module procedure :: pl_assign_line end interface interface is_parallel module procedure :: is_parallel_vectors module procedure :: is_parallel_lines module procedure :: is_parallel_planes end interface type :: plucker_line !! Defines a line in 3D Euclidean space using Plücker coordinates. real ( real64 ), public :: v ( 6 ) !! The 6-element array containing the Plücker coordinates. The !! first 3 elements contain the unit vector and the last 3 elements !! contain the moment vector. contains procedure , public :: u => pl_u procedure , public :: m => pl_m procedure , public :: to_array => pl_to_array end type interface plucker_line module procedure :: pl_from_2pts module procedure :: pl_from_line module procedure :: pl_from_2_planes module procedure :: pl_from_array end interface interface matmul module procedure :: pl_matmul end interface contains ! ****************************************************************************** ! PLANE ROUTINES ! ------------------------------------------------------------------------------ pure function plane_normal ( pln ) result ( rst ) !! Returns the normal vector of a plane. type ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ) :: rst ( 3 ) !! The normal vector. rst = [ pln % a , pln % b , pln % c ] rst = rst / norm2 ( rst ) end function ! ------------------------------------------------------------------------------ pure function plane_from_3pts ( pt1 , pt2 , pt3 ) result ( rst ) !! Constructs a plane from 3 points. The 3 points must not be colinear. real ( real64 ), intent ( in ) :: pt1 ( 3 ) !! The first point. real ( real64 ), intent ( in ) :: pt2 ( 3 ) !! The second point. real ( real64 ), intent ( in ) :: pt3 ( 3 ) !! The third point. type ( plane ) :: rst !! The resulting plane. real ( real64 ) :: ab ( 3 ), ac ( 3 ), nrm ( 3 ) ab = pt2 - pt1 ac = pt3 - pt1 nrm = cross_product ( ab , ac ) nrm = nrm / norm2 ( nrm ) rst = plane_from_point_and_normal ( pt1 , nrm ) end function ! ------------------------------------------------------------------------------ pure function plane_from_point_and_normal ( pt , nrm ) result ( rst ) !! Constructs a plane from a point which lies on the plane, and a !! unit vector normal to the plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point that lies on the plane. real ( real64 ), intent ( in ) :: nrm ( 3 ) !! The normal unit vector. type ( plane ) :: rst !! The resulting plane. real ( real64 ) :: nmag nmag = norm2 ( nrm ) rst % a = nrm ( 1 ) / nmag rst % b = nrm ( 2 ) / nmag rst % c = nrm ( 3 ) / nmag rst % d = - rst % a * pt ( 1 ) - rst % b * pt ( 2 ) - rst % c * pt ( 3 ) end function ! ------------------------------------------------------------------------------ pure function plane_from_many_points ( pts ) result ( rst ) !! Constructs the plane that best fits a cloud of points in a !! least-squares sense. real ( real64 ), intent ( in ), dimension (:,:) :: pts !! The N-by-3 matrix containing the N points to fit. N must be !! at least 3, but is typically much larger. type ( plane ) :: rst !! The resulting plane. ! Local Variables character :: jobu , jobvt integer ( int32 ) :: i , m , n , mn , lwork , info real ( real64 ), allocatable , dimension (:,:) :: shifted , vt real ( real64 ), allocatable , dimension (:) :: s , work real ( real64 ) :: temp ( 1 ), dummy ( 1 ), avg ( 3 ), nrm ( 3 ), nan ! Initialization jobu = 'N' jobvt = 'S' m = size ( pts , 1 ) n = size ( pts , 2 ) mn = min ( m , n ) nan = ieee_value ( nan , IEEE_QUIET_NAN ) ! Input Checking if ( m < 3 . or . n /= 3 ) then rst % a = nan rst % b = nan rst % c = nan rst % d = nan return end if ! Workspaec Sizing - only compute V**T call DGESVD ( jobu , jobvt , m , n , dummy , m , dummy , dummy , m , dummy , mn , & temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork ), vt ( mn , n ), shifted ( m , n ), s ( mn )) ! Process if ( m == 3 ) then ! An exact fit from 3 points rst = plane ( pts ( 1 ,:), pts ( 2 ,:), pts ( 3 ,:)) else avg ( 1 ) = mean ( pts (:, 1 )) avg ( 2 ) = mean ( pts (:, 2 )) avg ( 3 ) = mean ( pts (:, 3 )) do i = 1 , m shifted ( i ,:) = pts ( i ,:) - avg end do call DGESVD ( jobu , jobvt , m , n , shifted , m , s , dummy , m , vt , mn , & work , lwork , info ) if ( info /= 0 ) then rst % a = nan rst % b = nan rst % c = nan rst % d = nan return end if nrm = vt ( 3 ,:) nrm = nrm / norm2 ( nrm ) rst = plane ( avg , nrm ) end if end function ! ------------------------------------------------------------------------------ ! LINE MEMBER ROUTINES ! ------------------------------------------------------------------------------ subroutine plane_flip_normal ( this ) !! Flips the normal vector of the plane. class ( plane ), intent ( inout ) :: this !! The plane. ! Process this % a = - this % a this % b = - this % b this % c = - this % c end subroutine ! ------------------------------------------------------------------------------ ! PLANE OPERATORS ! ------------------------------------------------------------------------------ pure elemental subroutine plane_assign ( x , y ) !! Assigns a plane to another. type ( plane ), intent ( out ) :: x !! The resulting plane. type ( plane ), intent ( in ) :: y !! The source plane x % a = y % a x % b = y % b x % c = y % c x % d = y % d end subroutine ! ****************************************************************************** ! LINE ROUTINES ! ------------------------------------------------------------------------------ pure function line_from_2pts ( pt1 , pt2 ) result ( rst ) !! Constructs a line from two points. real ( real64 ), intent ( in ) :: pt1 ( 3 ) !! The first point. This point will act as the initial point !! along the line such that \\vec{r_o} = \\vec{pt_1} in the !! equation of the line \\vec{r} = \\vec{r_o} + t \\vec{v} . real ( real64 ), intent ( in ) :: pt2 ( 3 ) !! The second point. type ( line ) :: rst !! The resulting line. rst % r0 = pt1 rst % v = pt2 - pt1 end function ! ------------------------------------------------------------------------------ pure function line_from_2_planes ( p1 , p2 ) result ( rst ) !! Constructs a line from the intersection of two planes. class ( plane ), intent ( in ) :: p1 !! The first plane. class ( plane ), intent ( in ) :: p2 !! The second plane. type ( line ) :: rst !! The resulting line. NaN's are returned in the event that the !! two planes are parallel. ! Local Variables integer ( int32 ) :: ind real ( real64 ) :: n1 ( 3 ), n2 ( 3 ), a11 , a12 , a21 , a22 , b1 , b2 , & denom , x1 , x2 ! Compute the normal vectors of each plane n1 = plane_normal ( p1 ) n2 = plane_normal ( p2 ) ! Test to see if the planes are parallel if ( is_parallel ( n1 , n2 )) then rst % r0 = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) rst % v = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) return end if ! Obtain the direction of the line rst % v = cross_product ( n1 , n2 ) ! Find a point on the line. The idea is to first locate the index of ! the largest magnitue value in the direction vector. This component ! will cross zero at some point, and it is this point we seek to find. ind = maxloc ( abs ( rst % v ), 1 ) select case ( ind ) case ( 1 ) a11 = p1 % b a21 = p2 % b a12 = p1 % c a22 = p2 % c case ( 2 ) a11 = p1 % a a21 = p2 % a a12 = p1 % c a22 = p2 % c case default a11 = p1 % a a21 = p2 % a a12 = p1 % b a22 = p2 % b end select b1 = - p1 % d b2 = - p2 % d ! Solve the linear system denom = a11 * a22 - a12 * a21 x1 = ( a22 * b1 - a12 * b2 ) / denom x2 = ( a11 * b2 - a21 * b1 ) / denom ! Find a point along the line to call t = 0 select case ( ind ) case ( 1 ) rst % r0 ( 1 ) = 0.0d0 rst % r0 ( 2 ) = x1 rst % r0 ( 3 ) = x2 case ( 2 ) rst % r0 ( 1 ) = x1 rst % r0 ( 2 ) = 0.0d0 rst % r0 ( 3 ) = x2 case default rst % r0 ( 1 ) = x1 rst % r0 ( 2 ) = x2 rst % r0 ( 3 ) = 0.0d0 end select end function ! ------------------------------------------------------------------------------ pure function line_from_many_points ( pts ) result ( rst ) !! Constructs the line that best fits the supplied set of points in a !! least-squares sense. real ( real64 ), intent ( in ), dimension (:,:) :: pts !! An N-by-3 matrix where N is at least 2, but typically much !! larger. type ( line ) :: rst !! The resulting line. ! Local Variables character :: jobu , jobvt integer ( int32 ) :: i , m , n , mn , lwork , info real ( real64 ), allocatable , dimension (:,:) :: shifted , vt real ( real64 ), allocatable , dimension (:) :: s , work real ( real64 ) :: temp ( 1 ), dummy ( 1 ) ! Initialization jobu = 'N' jobvt = 'S' m = size ( pts , 1 ) n = size ( pts , 2 ) mn = min ( m , n ) ! Input Checking if ( m < 2 . or . n /= 3 ) then rst % r0 = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) rst % v = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) return end if ! Workspace Sizing - only compute V**T call DGESVD ( jobu , jobvt , m , n , dummy , m , dummy , dummy , m , dummy , mn , & temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork ), vt ( mn , n ), shifted ( m , n ), s ( mn )) ! Process if ( m == 2 ) then rst = line_from_2pts ( pts ( 1 ,:), pts ( 2 ,:)) else rst % r0 = [ mean ( pts (:, 1 )), mean ( pts (:, 2 )), mean ( pts (:, 3 ))] do i = 1 , m shifted ( i ,:) = pts ( i ,:) - rst % r0 end do call DGESVD ( jobu , jobvt , m , n , shifted , m , s , dummy , m , vt , mn , & work , lwork , info ) if ( info /= 0 ) then rst % r0 = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) rst % v = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) return end if rst % v = vt ( 1 ,:) / norm2 ( vt ( 1 ,:)) end if end function ! ------------------------------------------------------------------------------ pure function line_from_point_and_vector ( pt , x , nx ) result ( rst ) !! Constructs a new line from a point (defines the point where t = 0) !! and a direction vector. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point at which t = 0 on the line. real ( real64 ), intent ( in ) :: x ( 3 ) !! The direction vector defining the orientation of the line. logical , intent ( in ), optional :: nx !! An optional parameter that defines if x should be normalized to !! a unit vector (true), or left as-is (false). The default is !! true such that x is normalized to a unit vector. type ( line ) :: rst !! The resulting line. ! Local Variables logical :: nrm ! Initialization nrm = . true . if ( present ( nx )) nrm = nx ! Process rst % r0 = pt if ( nrm ) then rst % v = x / norm2 ( x ) else rst % v = x end if end function ! ------------------------------------------------------------------------------ ! LINE MEMBER ROUTINES ! ------------------------------------------------------------------------------ pure function line_eval ( this , t ) result ( rst ) !! Evaluates the equation of the line at the specified parameter. class ( line ), intent ( in ) :: this !! The line. real ( real64 ), intent ( in ) :: t !! The parameter. real ( real64 ) :: rst ( 3 ) !! The location along the line defined by the parameter t. rst = this % r0 + t * this % v end function ! ------------------------------------------------------------------------------ ! LINE OPERATORS ! ------------------------------------------------------------------------------ pure elemental subroutine line_assign ( x , y ) !! Assigns a line to another. type ( line ), intent ( out ) :: x !! The resulting line. type ( line ), intent ( in ) :: y !! The source line x % r0 = y % r0 x % v = y % v end subroutine ! ****************************************************************************** ! GEOMETRY CALCULATIONS ! ------------------------------------------------------------------------------ pure function is_parallel_vectors ( x , y , tol ) result ( rst ) !! Tests to see if two vectors are parallel. real ( real64 ), intent ( in ), dimension (:) :: x !! The first vector. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The second vector. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing for parallelism. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the vectors are parallel; else, false. ! Local Variables real ( real64 ) :: t , cp ( 3 ) ! Initialization if ( present ( tol )) then t = tol else t = 1.0d1 * epsilon ( t ) end if ! Process cp = cross_product ( x , y ) rst = ( abs ( cp ( 1 )) <= t . and . abs ( cp ( 2 )) <= t . and . abs ( cp ( 3 )) <= t ) end function ! ------------------------------------------------------------------------------ pure function is_parallel_lines ( x , y , tol ) result ( rst ) !! Tests to see if two lines are parallel. class ( line ), intent ( in ) :: x !! The first line. class ( line ), intent ( in ) :: y !! The second line. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing for parallelism. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the lines are parallel; else, false. ! Process rst = is_parallel_vectors ( x % v , y % v , tol = tol ) end function ! ------------------------------------------------------------------------------ pure function is_parallel_planes ( x , y , tol ) result ( rst ) !! Tests to see if two planes are parallel. class ( plane ), intent ( in ) :: x !! The first plane. class ( plane ), intent ( in ) :: y !! The second plane. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing for parallelism. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the planes are parallel; else, false. ! Process rst = is_parallel_vectors ( plane_normal ( x ), plane_normal ( y ), tol = tol ) end function ! ------------------------------------------------------------------------------ pure function is_point_on_plane ( pt , pln , tol ) result ( rst ) !! Tests to see if a point lies on a plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the point lies on the plane; else, false. ! Local Variables real ( real64 ) :: t , s ! Initialization if ( present ( tol )) then t = tol else t = 1.0d1 * epsilon ( t ) end if ! Process s = pln % a * pt ( 1 ) + pln % b * pt ( 2 ) + pln % c * pt ( 3 ) + pln % d rst = abs ( s ) <= t end function ! ------------------------------------------------------------------------------ pure function is_point_on_line ( pt , ln , tol ) result ( rst ) !! Tests to see if a point lies on a line. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( line ), intent ( in ) :: ln !! The line. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the point lies on the line; else, false. ! Local Variables real ( real64 ) :: t , d ! Initialization if ( present ( tol )) then t = tol else t = 1.0d1 * epsilon ( t ) end if ! Process d = point_to_line_distance ( pt , ln ) rst = d <= t ! d is always positive end function ! ------------------------------------------------------------------------------ pure function nearest_point_on_line ( pt , ln ) result ( rst ) !! Gets the line parameter for the point on the line nearest the !! specified point. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( line ), intent ( in ) :: ln !! The line. real ( real64 ) :: rst !! The line parameteric variable t defining the location of !! the point nearest along the line. ! References: ! https://mathworld.wolfram.com/Point-LineDistance3-Dimensional.html rst = - dot_product ( ln % r0 - pt , ln % v ) / ( norm2 ( ln % v ) ** 2 ) end function ! ------------------------------------------------------------------------------ pure function point_to_line_distance ( pt , ln ) result ( rst ) !! Computes the shortest distance between a point and a line. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( line ), intent ( in ) :: ln !! The line. real ( real64 ) :: rst !! The shortest distance between the point and line. ! Local Variables real ( real64 ) :: t , d ( 3 ) ! Process t = nearest_point_on_line ( pt , ln ) d = pt - ln % evaluate ( t ) rst = norm2 ( d ) end function ! ------------------------------------------------------------------------------ pure function point_to_plane_distance ( pt , pln ) result ( rst ) !! Computes the shortest distance between a point and a plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ) :: rst !! The shortest distance between the point and plane. ! Process rst = abs ( pln % a * pt ( 1 ) + pln % b * pt ( 2 ) + pln % c * pt ( 3 ) + pln % d ) / & norm2 ([ pln % a , pln % b , pln % c ]) end function ! ------------------------------------------------------------------------------ pure function vector_plane_projection ( x , pln ) result ( rst ) !! Projects a vector onto a plane. real ( real64 ), intent ( in ) :: x ( 3 ) !! The vector to project. class ( plane ), intent ( in ) :: pln !! The plane onto which to project the vector. real ( real64 ) :: rst ( 3 ) !! The projected vector. ! Local Variables real ( real64 ) :: nrm ( 3 ), y ( 3 ) ! Process nrm = plane_normal ( pln ) y = vector_projection ( x , nrm ) rst = x - y end function ! ------------------------------------------------------------------------------ pure function point_plane_projection ( pt , pln ) result ( rst ) !! Projects a point onto a plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( plane ), intent ( in ) :: pln !! The plane onto which to project the point. real ( real64 ) :: rst ( 3 ) !! The projected point. ! Local Variables real ( real64 ) :: t , n ( 3 ) ! Process n = [ pln % a , pln % b , pln % c ] t = - ( pln % c * pt ( 3 ) + pln % b * pt ( 2 ) + pln % a * pt ( 1 ) + pln % d ) / & ( norm2 ( n ) ** 2 ) rst = pt + t * n end function ! ****************************************************************************** ! PLUCKER_LINE ! ------------------------------------------------------------------------------ pure function pl_from_2pts ( pt1 , pt2 ) result ( rst ) !! Constructs a new plucker_line from two points. real ( real64 ), intent ( in ) :: pt1 ( 3 ) !! The first point. real ( real64 ), intent ( in ) :: pt2 ( 3 ) !! The second point. type ( plucker_line ) :: rst !! The resulting line. rst % v ( 1 : 3 ) = pt2 - pt1 rst % v ( 1 : 3 ) = rst % v ( 1 : 3 ) / norm2 ( rst % v ( 1 : 3 )) rst % v ( 4 : 6 ) = cross_product ( pt1 , rst % v ( 1 : 3 )) end function ! ------------------------------------------------------------------------------ pure function pl_from_line ( ln ) result ( rst ) !! Constructs a new plucker_line from a line object. class ( line ), intent ( in ) :: ln !! The line. type ( plucker_line ) :: rst !! The equivalent plucker_line. rst = pl_from_2pts ( ln % evaluate ( 0.0d0 ), ln % evaluate ( 1.0d0 )) end function ! ------------------------------------------------------------------------------ pure function pl_from_2_planes ( p1 , p2 ) result ( rst ) !! Constructs a new plucker_line from the intersection of two planes. class ( plane ), intent ( in ) :: p1 !! The first plane. class ( plane ), intent ( in ) :: p2 !! The second plane. type ( plucker_line ) :: rst !! The resulting line. NaN's are returned in the event that the !! two planes are parallel. rst = pl_from_line ( line ( p1 , p2 )) end function ! ------------------------------------------------------------------------------ pure function pl_from_array ( x , nrm ) result ( rst ) !! Constructs a new plucker_line from the supplied array. real ( real64 ), intent ( in ) :: x ( 6 ) !! A 6-element array containing the Plücker coordinates. logical , intent ( in ), optional :: nrm !! An optional input that specifies if the first three coordinates !! (the unit vector) should be normalized (true), or left as-is !! (false). The default is true such that the vector is normalized. type ( plucker_line ) :: rst !! The resulting line. logical :: n n = . true . if ( present ( nrm )) n = nrm if ( n ) then rst % v ( 1 : 3 ) = x ( 1 : 3 ) / norm2 ( x ( 1 : 3 )) rst % v ( 4 : 6 ) = x ( 4 : 6 ) else rst % v = x end if end function ! ------------------------------------------------------------------------------ pure function pl_matmul ( x , y ) result ( rst ) !! Overloads the matmul routine to allow for multiplication of the !! Plücker line coordinate vector with a matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x !! The N-by-6 matrix. type ( plucker_line ), intent ( in ) :: y !! The plucker_line object. real ( real64 ), allocatable , dimension (:) :: rst !! The resulting N-element array. rst = matmul ( x , y % v ) end function ! ------------------------------------------------------------------------------ ! PLUCKER_LINE OPERATORS ! ------------------------------------------------------------------------------ pure elemental subroutine pl_assign ( x , y ) !! Assigns a plucker_line to another. type ( plucker_line ), intent ( out ) :: x !! The resulting plucker_line. type ( plucker_line ), intent ( in ) :: y !! The source plucker_line. x % v = y % v end subroutine ! ------------------------------------------------------------------------------ pure elemental subroutine pl_assign_line ( x , y ) !! Assigns a line to a plucker_line. type ( plucker_line ), intent ( out ) :: x !! The resulting plucker_line. type ( line ), intent ( in ) :: y !! The source line. x = plucker_line ( y ) end subroutine ! ------------------------------------------------------------------------------ ! PLUCKER_LINE MEMBERS ! ------------------------------------------------------------------------------ pure function pl_u ( this ) result ( rst ) !! The unit vector representing the orientation of the line. class ( plucker_line ), intent ( in ) :: this !! The plucker_line object. real ( real64 ) :: rst ( 3 ) !! The unit vector. rst = this % v ( 1 : 3 ) end function ! ------------------------------------------------------------------------------ pure function pl_m ( this ) result ( rst ) !! The line moment vector. class ( plucker_line ), intent ( in ) :: this !! The plucker_line object. real ( real64 ) :: rst ( 3 ) !! The moment vector. rst = this % v ( 4 : 6 ) end function ! ------------------------------------------------------------------------------ pure function pl_to_array ( this ) result ( rst ) !! Returns the plucker_line as a 6-element array of the form [u, m]. class ( plucker_line ), intent ( in ) :: this !! The plucker_line object. real ( real64 ) :: rst ( 6 ) !! The resulting array. rst = this % v end function ! ****************************************************************************** ! ADDITIONAL GEOMETRIC CALCULATIONS (ADDED 3/5/2026, JAC) ! ------------------------------------------------------------------------------ pure function line_common_normal ( ln1 , ln2 ) result ( rst ) !! Returns the common normal line between two lines pointing from ln1 to !! ln2. In the event that the two lines are parallel within the !! specified tolerance, there exist an infinite number of common !! normals; therefore, a line will be chosen that runs from ln1 to ln2 !! with the point at t = 0 coincident with the point at t = 0 on ln1. class ( line ), intent ( in ) :: ln1 !! The first line. class ( line ), intent ( in ) :: ln2 !! The second line. type ( line ) :: rst !! The common normal line. The distance along this line between !! t = 0 and t = 1 defines the length of the common normal !! connecting ln1 to ln2. In the event that ln1 and ln2 intersect, !! the length of this line is zero. ! Local Variables logical :: coincident integer ( int32 ) :: lwork , info , ipvt ( 2 ), rnk real ( real64 ) :: s , t , xi ( 3 ), p1 ( 3 ), p2 ( 3 ), A ( 3 , 2 ), x ( 3 ), temp ( 1 ), rc real ( real64 ), allocatable , dimension (:) :: work ! Initialization t = 1.0d1 * epsilon ( t ) ipvt = 0 rc = epsilon ( rc ) ! Compute the cross products of the direction vectors. xi = cross_product ( ln2 % v , ln1 % v ) ! Locate the point on ln2 that is an intersection between the common ! normal and ln2. This can be accomplished by noting that: ! ! ln1%r0 + t * xi = ln2%ro + s * ln2%v ! ! We need to solve for s and t p1 = ln1 % evaluate ( 0.0d0 ) ! Compute the coefficient matrix A (:, 1 ) = xi A (:, 2 ) = - ln2 % v ! Compute the right-hand-side x = ln2 % r0 - ln1 % r0 ! Set up the least-squares solver. We use DGELSY as we have 3 equations ! but only 2 unknowns. call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Solve call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , work , lwork , info ) s = x ( 2 ) ! we can use either t or s. s is associated with ln2 p2 = ln2 % evaluate ( s ) rst = line ( p1 , p2 ) ! Ensure that rst is of finite length if ( norm2 ( rst % evaluate ( 1.0d0 ) - rst % evaluate ( 0.0d0 )) <= t ) then coincident = . true . else if ( ieee_is_nan ( rst % v ( 1 )) . or . ieee_is_nan ( rst % v ( 2 )) . or . & ieee_is_nan ( rst % v ( 3 ))) & then coincident = . true . else coincident = . false . end if if ( coincident ) then ! If the lines are coincident we offset them by the specified ! zero tolerance along the computed common normal axis rst % r0 = p1 rst % v = 0.0d0 end if end function ! ------------------------------------------------------------------------------ pure subroutine do_lines_intersect ( ln1 , ln2 , intersect , t1 , t2 , tol ) !! Tests to see if two lines intersect. class ( line ), intent ( in ) :: ln1 !! The first line. class ( line ), intent ( in ) :: ln2 !! The second line. logical , intent ( out ) :: intersect !! True if the two lines intersect within the specified tolerance; !! else, false if they do not intersect. real ( real64 ), intent ( out ), optional :: t1 !! The parametric value associate with ln1 defining the intersection !! point. real ( real64 ), intent ( out ), optional :: t2 !! The parametric value associate with ln2 defining the intersection !! point. real ( real64 ), intent ( in ), optional :: tol !! The intersection tolerance. If not supplied, the default value !! is 10x machine epsilon. ! Local Variables integer ( int32 ) :: lwork , info , rnk , ipvt ( 2 ) real ( real64 ) :: tolerance , A ( 3 , 2 ), x ( 3 ), s , t , temp ( 1 ), p1 ( 3 ), p2 ( 3 ), & dp ( 3 ), nan , rc real ( real64 ), allocatable , dimension (:) :: work ! Initialization if ( present ( tol )) then tolerance = tol else tolerance = 1.0d1 * epsilon ( tolerance ) end if nan = ieee_value ( nan , IEEE_QUIET_NAN ) A (:, 1 ) = ln2 % v A (:, 2 ) = - ln1 % v x = ln1 % r0 - ln2 % r0 ipvt = 0 rc = epsilon ( rc ) ! Set up the least-squares solver call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Solve A {s;t} = X call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , work , lwork , info ) if ( info /= 0 ) then intersect = . false . s = nan t = nan else s = x ( 1 ) t = x ( 2 ) p1 = ln1 % evaluate ( t ) p2 = ln2 % evaluate ( s ) dp = abs ( p2 - p1 ) if ( dp ( 1 ) > tolerance . or . dp ( 2 ) > tolerance . or . & dp ( 3 ) > tolerance ) & then ! No intersection intersect = . false . s = nan t = nan else ! We've got an intersection point intersect = . true . end if end if if ( present ( t1 )) t1 = t if ( present ( t2 )) t2 = s end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_geometry.f90.html"},{"title":"dynamics_helper.f90 – DYNAMICS","text":"Contents Modules dynamics_helper Source Code dynamics_helper.f90 Source Code module dynamics_helper use iso_fortran_env implicit none private public :: cross_product public :: to_skew_symmetric public :: vector_angle public :: scalar_projection public :: vector_projection contains ! ------------------------------------------------------------------------------ pure function cross_product ( x , y ) result ( rst ) !! Computes the cross-product of a vector. real ( real64 ), intent ( in ) :: x ( 3 ) !! The left-hand-side argument. real ( real64 ), intent ( in ) :: y ( 3 ) !! The right-hand-side argument real ( real64 ) :: rst ( 3 ) !! The resulting vector. rst ( 1 ) = x ( 2 ) * y ( 3 ) - x ( 3 ) * y ( 2 ) rst ( 2 ) = x ( 3 ) * y ( 1 ) - x ( 1 ) * y ( 3 ) rst ( 3 ) = x ( 1 ) * y ( 2 ) - x ( 2 ) * y ( 1 ) end function ! ------------------------------------------------------------------------------ pure function to_skew_symmetric ( x ) result ( rst ) !! Converts a 3-element vector to a 3-by-3 skew-symmetric matrix. A !! skew-symmetric matrix is defined as follows. !! !! \\tilde{x} = \\left[ \\begin{matrix} 0 & -x_{3} & x_{2} \\\\ !! x_{3} & 0 & -x_{1} \\\\ -x_{2} & x_{1} & 0 \\end{matrix} \\right] real ( real64 ), intent ( in ) :: x ( 3 ) !! The vector. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting skew-symmetric matrix. ! Process rst = reshape ([ & 0.0d0 , x ( 3 ), - x ( 2 ), & - x ( 3 ), 0.0d0 , x ( 1 ), & x ( 2 ), - x ( 1 ), 0.0d0 & ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function vector_angle ( x , y ) result ( rst ) !! Computes the angle between two vectors. real ( real64 ), intent ( in ), dimension (:) :: x !! The first vector. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The second vector. real ( real64 ) :: rst !! The angle, in radians. ! Local Variables real ( real64 ) :: xmag , ymag , ct ! Process xmag = norm2 ( x ) ymag = norm2 ( y ) ct = dot_product ( x , y ) / ( xmag * ymag ) rst = acos ( ct ) end function ! ------------------------------------------------------------------------------ pure function scalar_projection ( x , y ) result ( rst ) !! Computes the projection of vector x onto vector y. The scalar projection !! is defined such that s = \\frac{\\vec{x} \\cdot \\vec{y}}{||\\vec{y}||} . real ( real64 ), intent ( in ), dimension (:) :: x !! The vector to project. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The vector onto which x should be projected. real ( real64 ) :: rst !! The scalar projection of x onto y. ! Process rst = dot_product ( x , y ) / norm2 ( y ) end function ! ------------------------------------------------------------------------------ pure function vector_projection ( x , y ) result ( rst ) !! Computes the vector pojection of vector x onto vector y. The vector !! projection is defined such that proj_{y} \\vec{x} = !! \\frac{\\vec{x} \\cdot \\vec{y}}{||\\vec{y}||^{2}} \\vec{y} real ( real64 ), intent ( in ), dimension (:) :: x !! The vector to project. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The vector onto which x should be projected. real ( real64 ) :: rst ( 3 ) !! The vector projection of x onto y. ! Process rst = y * dot_product ( x , y ) / dot_product ( y , y ) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_helper.f90.html"},{"title":"dynamics_kinematics.f90 – DYNAMICS","text":"Contents Modules dynamics_kinematics Source Code dynamics_kinematics.f90 Source Code module dynamics_kinematics use iso_fortran_env use nonlin use ferror use dynamics_error_handling use dynamics_helper use dynamics_geometry use dynamics_quaternions implicit none private public :: identity_4 public :: dh_rotate_x public :: dh_rotate_z public :: dh_translate_x public :: dh_translate_z public :: dh_matrix public :: dh_forward_kinematics public :: solve_inverse_kinematics public :: vecfcn public :: jacobianfcn public :: least_squares_solver public :: iteration_behavior public :: vecfcn_helper public :: jacobian_generating_vector public :: dh_jacobian public :: REVOLUTE_JOINT public :: PRISMATIC_JOINT public :: coordinate_system public :: dh_parameter_set public :: dh_table interface dh_forward_kinematics module procedure :: dh_forward_kinematics_2 module procedure :: dh_forward_kinematics_3 module procedure :: dh_forward_kinematics_4 module procedure :: dh_forward_kinematics_5 module procedure :: dh_forward_kinematics_6 module procedure :: dh_forward_kinematics_7 module procedure :: dh_forward_kinematics_8 module procedure :: dh_forward_kinematics_array module procedure :: dh_forward_kinematics_dh_params module procedure :: dh_forward_kinematics_dh_table end interface interface dh_jacobian module procedure :: dh_build_jacobian end interface integer ( int32 ), parameter :: REVOLUTE_JOINT = 0 !! Defines a revolute joint. integer ( int32 ), parameter :: PRISMATIC_JOINT = 1 !! Defines a prismatic joint. type coordinate_system !! Defines a 3D Cartesian coordinate system. real ( real64 ) :: origin ( 3 ) !! The location of the origin of the coordinate system in the parent !! coordinate system. real ( real64 ) :: i ( 3 ) !! The unit vector along the coordinate system's x-axis. real ( real64 ) :: j ( 3 ) !! The unit vector along the coordinate system's y-axis. real ( real64 ) :: k ( 3 ) !! The unit vector along the coordinate system's z-axis. end type interface coordinate_system module procedure :: define_link_csys module procedure :: define_csys end interface type dh_parameter_set !! Describes a set of Denavit-Hartenberg parameters for a single joint. real ( real64 ) :: link_length !! The link length is the distance between the proximal and distal !! joint axes as measured along the link's x-axis. real ( real64 ) :: link_twist !! The link twist is the required rotation of the proximal joint !! axis about the link's x-axis to become parallel to the distal !! joint's axis. real ( real64 ) :: link_offset !! The link offset is the distance between the previous link's !! x-axis and the current link's x-axis as measured along the !! axis of the proximal joint. real ( real64 ) :: joint_angle !! The joint angle is the required rotation of the previous link's !! x-axis about the proximal joint's axis to become parallel to the !! current link's x-axis. end type interface dh_parameter_set module procedure :: dps_init end interface type dh_table !! Describes a Denavit-Hartenberg table. type ( dh_parameter_set ), allocatable , dimension (:) :: parameters !! A collection of DH parameters for each joint in the linkage. end type interface dh_table module procedure :: dh_table_init end interface ! ------------------------------------------------------------------------------ ! PRIVATE - INVERSE KINEMATICS type inverse_kinematics_container !! A container for passing kinematics information around the inverse !! solver. procedure ( vecfcn ), pointer , nopass :: kinematics_equations !! A pointer to the kinematics equations. real ( real64 ), allocatable , dimension (:) :: kinematic_constraints !! A constraints array. class ( * ), pointer :: user_args => null () !! User supplied arguments to the kinematics_equations model. end type contains ! ------------------------------------------------------------------------------ pure function identity_4 () result ( rst ) !! Computes a 4-by-4 identity matrix. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting identity matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 ! Process rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = one rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_rotate_x ( alpha ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local x-axis rotation. real ( real64 ), intent ( in ) :: alpha !! The rotation angle, in radians. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 real ( real64 ) :: cx , sx ! Process cx = cos ( alpha ) sx = sin ( alpha ) rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = cx rst ( 3 , 2 ) = sx rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = - sx rst ( 3 , 3 ) = cx rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_rotate_z ( theta ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local z-axis rotation. real ( real64 ), intent ( in ) :: theta !! The rotation angle, in radians. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 real ( real64 ) :: cx , sx ! Process cx = cos ( theta ) sx = sin ( theta ) rst ( 1 , 1 ) = cx rst ( 2 , 1 ) = sx rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = - sx rst ( 2 , 2 ) = cx rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_translate_x ( a ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local x-axis !! translation. real ( real64 ), intent ( in ) :: a !! The translation. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 ! Process rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = one rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = a rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_translate_z ( d ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local z-axis !! translation. real ( real64 ), intent ( in ) :: d !! The translation. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 ! Process rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = one rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = d rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_matrix ( alpha , a , theta , d ) result ( rst ) !! Computes the Denavit-Hartenberg transformation matrix for the !! specified DH parameters. real ( real64 ), intent ( in ) :: alpha !! The link twist angle, in radians. This angle is the required !! rotation of the z(i-1) axis about the link's x-axis to become !! parallel with the link's z-axis. real ( real64 ), intent ( in ) :: a !! The link length as measured along the link's x-axis. real ( real64 ), intent ( in ) :: theta !! The joint angle, in radians. This angle is the required rotation !! of the z(i-1) axis about the z(i-1) axis to become parallel with !! the link's x-axis. real ( real64 ), intent ( in ) :: d !! The joint offset distance measured as the distance between the !! x(i-1) axis and the link's x-axis along the z(i-1) axis. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables real ( real64 ), dimension ( 4 , 4 ) :: Rx , Dx , Rz , Dz , DxRx , RzDxRx ! Compute the matrices Rx = dh_rotate_x ( alpha ) Dx = dh_translate_x ( a ) Rz = dh_rotate_z ( theta ) Dz = dh_translate_z ( d ) ! Perform the multiplication DxRx = matmul ( Dx , Rx ) RzDxRx = matmul ( Rz , DxRx ) rst = matmul ( Dz , RzDxRx ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_2 ( T1 , T2 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Process rst = matmul ( T1 , T2 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_3 ( T1 , T2 , T3 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_2 ( T1 , T2 ) rst = matmul ( T0 , T3 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_4 ( T1 , T2 , T3 , T4 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_3 ( T1 , T2 , T3 ) rst = matmul ( T0 , T4 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_5 ( T1 , T2 , T3 , T4 , T5 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_4 ( T1 , T2 , T3 , T4 ) rst = matmul ( T0 , T5 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_6 ( T1 , T2 , T3 , T4 , T5 , T6 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ), intent ( in ) :: T6 ( 4 , 4 ) !! The transformation matrix for the sixth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_5 ( T1 , T2 , T3 , T4 , T5 ) rst = matmul ( T0 , T6 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_7 ( T1 , T2 , T3 , T4 , T5 , T6 , T7 ) & result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ), intent ( in ) :: T6 ( 4 , 4 ) !! The transformation matrix for the sixth link in the linkage. real ( real64 ), intent ( in ) :: T7 ( 4 , 4 ) !! The transformation matrix for the seventh link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_6 ( T1 , T2 , T3 , T4 , T5 , T6 ) rst = matmul ( T0 , T7 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_8 ( T1 , T2 , T3 , T4 , T5 , T6 , T7 , T8 ) & result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ), intent ( in ) :: T6 ( 4 , 4 ) !! The transformation matrix for the sixth link in the linkage. real ( real64 ), intent ( in ) :: T7 ( 4 , 4 ) !! The transformation matrix for the seventh link in the linkage. real ( real64 ), intent ( in ) :: T8 ( 4 , 4 ) !! The transformation matrix for the eigth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_7 ( T1 , T2 , T3 , T4 , T5 , T6 , T7 ) rst = matmul ( T0 , T8 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_array ( alpha , a , theta , d ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. The first entry must !! be from the first link nearest ground. real ( real64 ), intent ( in ), dimension (:) :: alpha !! The link twist angles, in radians. This angle is the required !! rotation of the z(i-1) axis about the link's x-axis to become !! parallel with the link's z-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: a !! The link lengths as measured along the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: theta !! The joint angles, in radians. This angle is the required rotation !! of the z(i-1) axis about the z(i-1) axis to become parallel with !! the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: d !! The joint offsets distance measured as the distance between the !! x(i-1) axis and the link's x-axis along the z(i-1) axis. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: Ti ( 4 , 4 ) ! Initialization n = size ( alpha ) rst = identity_4 () ! Process do i = 1 , n Ti = dh_matrix ( alpha ( i ), a ( i ), theta ( i ), d ( i )) rst = matmul ( rst , Ti ) end do end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_dh_params ( x ) result ( rst ) !! Assembles all of the individual link transformation matrices into !! a single transformation matrix locating the end-effector in the !! parent coordinate system for the overall mechanism. class ( dh_parameter_set ), intent ( in ), dimension (:) :: x !! The list of DH parameters. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: Ti ( 4 , 4 ) ! Initialization n = size ( x ) rst = identity_4 () ! Process do i = 1 , n Ti = dh_matrix ( x ( i )% link_twist , x ( i )% link_length , & x ( i )% joint_angle , x ( i )% link_offset ) rst = matmul ( rst , Ti ) end do end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_dh_table ( x ) result ( rst ) !! Assembles all of the individual link transformation matrices into !! a single transformation matrix locating the end-effector in the !! parent coordinate system for the overall mechanism. class ( dh_table ), intent ( in ) :: x !! The DH table. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Process rst = dh_forward_kinematics ( x % parameters ) end function ! ------------------------------------------------------------------------------ function solve_inverse_kinematics ( mdl , qo , constraints , df , & slvr , ib , jfcn , qmax , qmin , args , err ) result ( rst ) !! Solves the inverse kinematics problem for a linkage. An iterative !! solution procedure is utilized. procedure ( vecfcn ), intent ( in ), pointer :: mdl !! A routine used to compute the forward kinematics for the linkage !! given the current joint variable estimates. real ( real64 ), intent ( in ), dimension (:) :: qo !! An M-element array containing an initial estimate of the M joint !! variables. real ( real64 ), intent ( in ), target , dimension (:) :: constraints !! An N-element array containing the target values (constraints) for !! each of the N kinematic equations in the model. N must be at !! least equal to M (the number of joint variables). real ( real64 ), intent ( out ), optional , target , dimension (:) :: df !! An optional N-element array that, if supplied, can be used to !! retrieve the residuals of each of the N kinematic equations. class ( constrained_equation_solver ), intent ( inout ), optional , target :: slvr !! An optional solver that can be used in place of the default !! Levenberg-Marquardt solver. type ( iteration_behavior ), intent ( out ), optional :: ib !! An optional output that can be used to gather information on the !! solver. procedure ( jacobianfcn ), intent ( in ), pointer , optional :: jfcn !! A routine that can be used to provide the Jacobian matrix for !! the linkage. real ( real64 ), intent ( in ), dimension ( size ( qo )), optional :: qmax !! An optional set of upper limits on each of the joint variables. !! If not provided, the default is the output of the 'huge' !! intrinsic function. real ( real64 ), intent ( in ), dimension ( size ( qo )), optional :: qmin !! An optional set of lower limits on each of the joint variables. !! If not provided, the default is the negative of the output of !! the 'huge' intrinsic function. class ( * ), intent ( inout ), optional , target :: args !! An optional argument that can be used to communicate with mdl. class ( errors ), intent ( inout ), optional , target :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. real ( real64 ), allocatable , dimension (:) :: rst !! An M-element array containing the computed joint variables. ! Local Variables integer ( int32 ) :: nvar , neqn , flag real ( real64 ), pointer , dimension (:) :: resid real ( real64 ), allocatable , target , dimension (:) :: dresid type ( vecfcn_helper ) :: helper class ( constrained_equation_solver ), pointer :: solver type ( constrained_least_squares_solver ), target :: default_solver procedure ( vecfcn ), pointer :: fcn class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( inverse_kinematics_container ) :: obj ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if nvar = size ( qo ) neqn = size ( constraints ) if ( present ( slvr )) then solver => slvr else solver => default_solver end if obj % kinematics_equations => mdl obj % kinematic_constraints = constraints if ( present ( args )) obj % user_args => args ! Input Check if ( neqn < nvar ) then call report_constraint_count_error ( \"solve_inverse_kinematics\" , & nvar , neqn , errmgr ) return end if if ( present ( df )) then if ( size ( df ) /= neqn ) then call report_array_size_error ( \"solve_inverse_kinematics\" , \"df\" , & neqn , size ( df ), errmgr ) return end if end if if ( present ( qmax )) call solver % set_upper_limits ( qmax ) if ( present ( qmin )) call solver % set_lower_limits ( qmin ) ! Set up the solver fcn => inverse_kinematics_solver_fcn call helper % set_fcn ( fcn , neqn , nvar ) if ( present ( jfcn )) then call helper % set_jacobian ( jfcn ) end if ! Local Memory Allocations allocate ( rst ( nvar ), source = qo , stat = flag ) if ( present ( df )) then resid => df else if ( flag == 0 ) allocate ( dresid ( neqn ), stat = flag ) if ( flag == 0 ) resid => dresid end if if ( flag /= 0 ) then call report_memory_error ( \"solve_inverse_kinematics\" , flag , errmgr ) return end if ! Solve the problem call solver % solve ( helper , rst , resid , ib = ib , args = obj , err = errmgr ) end function ! ---------- subroutine inverse_kinematics_solver_fcn ( x , f , args ) ! Routine called by the inverse kinematics solver real ( real64 ), intent ( in ), dimension (:) :: x real ( real64 ), intent ( out ), dimension (:) :: f class ( * ), intent ( inout ), optional :: args ! Process select type ( args ) class is ( inverse_kinematics_container ) ! Compute the kinematics equations if ( associated ( args % user_args )) then call args % kinematics_equations ( x , f , args % user_args ) else call args % kinematics_equations ( x , f ) end if ! Compare with the constraints f = f - args % kinematic_constraints end select end subroutine ! ****************************************************************************** ! V1.0.8 ADDITIONS ! JAN. 29, 2025 ! ------------------------------------------------------------------------------ pure function jacobian_generating_vector ( d , k , R , jtype ) result ( rst ) !! Computes a single Jacobian generating vector given the position vector !! of the link origin, \\vec{d}, and the joint axis unit vector, !! \\vec{k}. !! !! For a revolute joint: !! !! \\vec{c_{i}} = \\left( \\begin{matrix} !! R \\left( \\hat{k} \\times \\vec{d_{i-1}} \\right) \\\\ !! \\vec{k_{i-1}} \\end{matrix} \\right) !! !! For a prismatic joint: !! !! \\vec{c_{i}} = \\left( \\begin{matrix} \\vec{k_{i-1}} \\\\ 0 \\end{matrix} !! \\right) !! !! The Jacobian matrix is then constructed from the Jacobian generating !! vectors as follows. !! !! J = \\left[ \\begin{matrix} \\vec{c_1} & \\vec{c_2} & ... & \\vec{c_n} !! \\end{matrix} \\right] real ( real64 ), intent ( in ) :: d ( 3 ) !! The position vector of the end-effector, \\vec{d}, relative to the !! link coordinate frame given in the base coordinate frame. An easy !! way to compute this vector is to extract the first 3 elements of the !! 4th column of the transformation matrix: T_{i} T_{i+1} ... T_{n}. real ( real64 ), intent ( in ) :: k ( 3 ) !! The unit vector defining the joint axis, \\vec{k}, given in the !! base coordinate frame. This vector can be computed most easily by !! using the transformation matrix: T = T_1 T_2 ... T_{i-1} and !! then computing \\vec{k_{i-1}} = T \\hat{k}. real ( real64 ), intent ( in ) :: R ( 3 , 3 ) !! The rotation matrix defining the orientation of the link coordinate !! frame relative to the base coordinate frame. integer ( int32 ), intent ( in ) :: jtype !! The joint type. Must be either REVOLUTE_JOINT or PRISMATIC_JOINT. !! If incorrectly specified, the code defaults to a REVOLUTE_JOINT type. real ( real64 ) :: rst ( 6 ) !! The resulting 6-element Jacobian generating vector. ! Parameter real ( real64 ), parameter :: zi ( 3 ) = [ 0.0d0 , 0.0d0 , 1.0d0 ] ! Local Variables real ( real64 ) :: kmag , kcrossd , kunit ( 3 ) ! Ensure k is a unit vector kmag = norm2 ( k ) kunit = k / kmag ! Process if ( jtype == PRISMATIC_JOINT ) then rst ( 1 : 3 ) = kunit rst ( 4 : 6 ) = 0.0d0 else ! Compute the cross-product term rst ( 1 : 3 ) = matmul ( R , cross_product ( zi , d )) ! Fill in the remaining components rst ( 4 : 6 ) = kunit end if end function ! ------------------------------------------------------------------------------ function dh_build_jacobian ( alpha , a , theta , d , jtypes ) result ( rst ) !! Builds the Jacobian matrix for a linkage given the Denavit-Hartenberg !! parameters. The first entry in each array must be from the first link !! nearest ground. The Jacobian matrix relates the joint velocities !! \\dot{\\vec{q}} to the end-effector velocity \\dot{\\vec{X}} by !! \\dot{\\vec{X}} = J \\dot{\\vec{q}}. real ( real64 ), intent ( in ), dimension (:) :: alpha !! The link twist angles, in radians. This angle is the required !! rotation of the z(i-1) axis about the link's x-axis to become !! parallel with the link's z-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: a !! The link lengths as measured along the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: theta !! The joint angles, in radians. This angle is the required rotation !! of the z(i-1) axis about the z(i-1) axis to become parallel with !! the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: d !! The joint offsets distance measured as the distance between the !! x(i-1) axis and the link's x-axis along the z(i-1) axis. integer ( int32 ), intent ( in ), dimension ( size ( alpha )) :: jtypes !! The types of each joint. Must be either REVOLUTE_JOINT or !! PRISMATIC_JOINT. The code defaults to REVOLUTE_JOINT. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 6-by-N Jacobian matrix where N is the number of joint !! variables (i.e. the length of the input arrays). ! Parameters real ( real64 ), parameter :: zi_1 ( 4 ) = [ 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 ] ! Local Variables integer ( int32 ) :: i , j , n real ( real64 ) :: Ti ( 4 , 4 ), T ( 4 , 4 ), Te ( 4 , 4 ), temp ( 4 , 4 ), di_1 ( 3 ), ki_1 ( 4 ) ! Initialization n = size ( alpha ) T = identity_4 () allocate ( rst ( 6 , n )) ! Process do i = 1 , n ! Compute the orientation vector ki_1 = matmul ( T , zi_1 ) ! Compute the link transformation matrix Ti = dh_matrix ( alpha ( i ), a ( i ), theta ( i ), d ( i )) ! Compute the transformation matrix relating the link to the end ! effector. Te = Ti do j = i + 1 , n temp = dh_matrix ( alpha ( j ), a ( j ), theta ( j ), d ( j )) Te = matmul ( Te , temp ) end do ! Compute the end-effector position vector di_1 = Te ( 1 : 3 , 4 ) ! Compute the Jacobian generating vector rst (:, i ) = jacobian_generating_vector ( di_1 , ki_1 ( 1 : 3 ), T ( 1 : 3 , 1 : 3 ), & jtypes ( i )) ! Update the transformation matrix T = matmul ( T , Ti ) end do end function ! ****************************************************************************** ! COORDINATE SYSTEM ROUTINES - V1.2.2 ADDITIONS ! ------------------------------------------------------------------------------ pure function define_link_csys ( xim1 , zim1 , zi , rim1 , ri ) & result ( rst ) !! Defines the DH coordinate system for the specified link. real ( real64 ), intent ( in ) :: xim1 ( 3 ) !! The x-axis of the previous link. real ( real64 ), intent ( in ) :: zim1 ( 3 ) !! The z-axis of the previous link. This is also the axis of the !! proximal joint of the current link. real ( real64 ), intent ( in ) :: zi ( 3 ) !! The axis of the distal joint of the current link. real ( real64 ), intent ( in ) :: rim1 ( 3 ) !! The location of the proximal joint's center or home position. real ( real64 ), intent ( in ) :: ri ( 3 ) !! The location of the distal joint's center or home position. type ( coordinate_system ) :: rst !! The resulting coordinate system. ! Local Variables logical :: intersect type ( line ) :: cn , lzim1 , lzi real ( real64 ) :: length , tol , pt0 ( 3 ) ! Initialization tol = 1.0d1 * epsilon ( tol ) ! zero tolerance lzim1 = line_from_point_and_vector ( rim1 , zim1 ) lzi = line_from_point_and_vector ( ri , zi ) ! Process call do_lines_intersect ( lzim1 , lzi , intersect ) if ( intersect ) then ! The two joint axes intersect. The x-axis as follows. rst % i = cross_product ( zim1 , zi ) ! Define the origin rst % origin = ri else ! Define the common normal between the two axes cn = line_common_normal ( lzim1 , lzi ) pt0 = cn % evaluate ( 1.0d0 ) length = norm2 ( pt0 - cn % evaluate ( 0.0d0 )) if ( length < tol ) then ! The axes are effectively colinear. The x-axis is chosen ! such that theta = 0 (i.e. the x axis is parallel with the ! previous x axis) rst % i = xim1 pt0 = ri else rst % i = cn % v end if ! The origin is the point of intersection of the common normal with ! the distal joint axis rst % origin = pt0 end if rst % i = rst % i / norm2 ( rst % i ) ! ensure i is a unit vector ! Store z, and normalize to a unit vector rst % k = zi / norm2 ( zi ) ! Compute y rst % j = cross_product ( rst % k , rst % i ) end function ! ------------------------------------------------------------------------------ pure function define_csys ( i , j , k , o ) result ( rst ) !! Defines a new coordinate_system object. It is the callers !! responsibility to ensure that the supplied vectors are orthogonal !! to one another. real ( real64 ), intent ( in ) :: i ( 3 ) !! The x-axis unit vector. real ( real64 ), intent ( in ) :: j ( 3 ) !! The y-axis unit vector. real ( real64 ), intent ( in ) :: k ( 3 ) !! The x-axis unit vector. real ( real64 ), intent ( in ), optional :: o ( 3 ) !! The location of the coordinate system within a reference !! coordinate system. If not supplied, a value of (0, 0, 0) will !! be used. type ( coordinate_system ) :: rst !! The new coordinate_system object. rst % i = i / norm2 ( i ) rst % j = j / norm2 ( j ) rst % k = k / norm2 ( k ) if ( present ( o )) then rst % origin = o else rst % origin = [ 0.0d0 , 0.0d0 , 0.0d0 ] end if end function ! ****************************************************************************** ! DENAVIT-HARTENBERG PARAMETER SET ROUTINES ! ------------------------------------------------------------------------------ pure function dps_init ( length , twist , offset , angle ) result ( rst ) !! Constructs a new dh_parameter_set object. real ( real64 ), intent ( in ) :: length !! The link length. real ( real64 ), intent ( in ) :: twist !! The link twist. real ( real64 ), intent ( in ) :: offset !! The link offset. real ( real64 ), intent ( in ) :: angle !! The joint angle. type ( dh_parameter_set ) :: rst !! The new dh_parameter_set object. rst % link_length = length rst % link_twist = twist rst % link_offset = offset rst % joint_angle = angle end function ! ****************************************************************************** ! DENAVIT-HARTENBERG TABLE ROUTINES ! ------------------------------------------------------------------------------ pure function dh_table_init ( c ) result ( rst ) !! Constructs a Denavit-Hartenberg table given the locations and !! orientations of a linkage. class ( coordinate_system ), intent ( in ), dimension (:) :: c !! An N-element array containing the coordinate frames for each !! of the N links of the linkage. type ( dh_table ) :: rst !! The resulting Denavit-Hartenberg table. ! Local Variables integer ( int32 ) :: i , n ! Initialization n = size ( c ) allocate ( rst % parameters ( n - 1 )) ! Process do i = 2 , n rst % parameters ( i - 1 )% link_length = & compute_dh_link_length ( c ( i - 1 ), c ( i )) rst % parameters ( i - 1 )% link_twist = & compute_dh_link_twist ( c ( i - 1 ), c ( i )) rst % parameters ( i - 1 )% link_offset = & compute_dh_link_offset ( c ( i - 1 ), c ( i )) rst % parameters ( i - 1 )% joint_angle = & compute_dh_joint_angle ( c ( i - 1 ), c ( i )) end do end function ! ------------------------------------------------------------------------------ pure function compute_dh_link_length ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg link length as the distance between !! the cs2 z-axis and the cs1 z-axis as measured along the cs2 x-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The link length. ! Local Variables real ( real64 ) :: v ( 3 ), pv ( 3 ) ! Compute a vector between the two coordinate system origins v = cs2 % origin - cs1 % origin ! Project the vector onto the cs2 x-axis pv = vector_projection ( v , cs2 % i ) ! The result is the length of the projected vector rst = norm2 ( pv ) end function ! ------------------------------------------------------------------------------ pure function compute_dh_link_twist ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg link twist as the required rotation !! of the cs1 z-axis about the cs2 x-axis to become parallel to the !! cs2 z-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The link twist angle, in radians. A positive angle is defined !! via the right-hand-rule. ! Local Variables real ( real64 ) :: pz1 ( 3 ), tol ! Initialization tol = 1.0d1 * epsilon ( tol ) ! Description: ! To compute the angle about the cs2 x-axis, the cs1 z-axis will be ! projected onto the plane formed by the cs2 y and z axes. The angle ! between the projected vector and the cs2 z-axis can then be ! determined. ! ! To project a vector onto a plane, assume we're projecting vector X ! onto plane P that has a unit normal N. The projected vector is then ! X - (X dot N) * N. For this instance, the normal vector of the cs2 ! y-z plane is the cs2 x-axis. pz1 = cs1 % k - dot_product ( cs1 % k , cs2 % i ) * cs2 % i ! Now, the angle between vectors may be determined. if ( norm2 ( pz1 ) < tol ) then ! The projected vector has a length of zero rst = 0.0d0 else ! Compute the angle rst = compute_vector_angle ( cs2 % i , cs2 % k , pz1 ) end if end function ! ------------------------------------------------------------------------------ pure function compute_dh_link_offset ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg link offset as the distance between !! the cs1 x-axis and the cs2 x-axis as measured along the cs1 z-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The link offset. ! Local Variables real ( real64 ) :: v ( 3 ), pv ( 3 ) ! Compute a vector between the two coordinate system origins v = cs2 % origin - cs1 % origin ! Project the vector onto the cs1 z-axis pv = vector_projection ( v , cs1 % k ) ! The result is the length of the projected vector rst = norm2 ( pv ) end function ! ------------------------------------------------------------------------------ pure function compute_dh_joint_angle ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg joint angle as rotation required of !! cs1 x-axis about the cs1 z-axis to become parallel to the cs2 x-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The joint angle, in radians. A positive angle is defined !! via the right-hand-rule. ! Local Variables real ( real64 ) :: px2 ( 3 ), tol ! Initialization tol = 1.0d1 * epsilon ( tol ) ! Description: ! To compute the angle about the cs1 z-axis, the cs2 x-axis will be ! projected onto the plane formed by the cs1 x-y plane. The angle ! between the projected vector and the cs1 x-axis can then be ! determined. ! ! To project a vector onto a plane, assume we're projecting vector X ! onto plane P that has a unit normal N. The projected vector is then ! X - (X dot N) * N. For this instance, the normal vector of the cs1 ! x-y plane is the cs1 z-axis. px2 = cs2 % i - dot_product ( cs2 % i , cs1 % k ) * cs1 % k ! Now, the angle between vectors may be determined if ( norm2 ( px2 ) < tol ) then ! The projected vector has a length of zero rst = 0.0d0 else ! Compute the angle rst = compute_vector_angle ( - cs1 % k , cs1 % i , px2 ) end if end function ! ------------------------------------------------------------------------------ pure function compute_vector_angle ( axis , x , y ) result ( rst ) !! Computes the angle of rotation between two vectors as measured about !! the specified axis. real ( real64 ), intent ( in ) :: axis ( 3 ) !! The rotation axis. real ( real64 ), intent ( in ) :: x ( 3 ) !! The target vector. real ( real64 ), intent ( in ) :: y ( 3 ) !! The other vector. real ( real64 ) :: rst !! The angle, with correct sign assuming a right-hand convention. ! Parameters real ( real64 ), parameter :: half_pi = acos ( 0.0d0 ) ! Local Variables type ( quaternion ) :: q real ( real64 ) :: ry ( 3 ), xy , xymag , tol logical :: parallel ! Initialization tol = 1.0d1 * epsilon ( tol ) ! Determine the angle rst = vector_angle ( x , y ) ! To determine the sign, we can establish a quaternion and perform the ! rotation of one vector onto the other. q = quaternion ( rst , axis ) ! angle and axis construction ry = aimag ( q * y * conjg ( q )) xy = dot_product ( x , ry ) xymag = norm2 ( x ) * norm2 ( ry ) parallel = abs ( abs ( xy ) - xymag ) < tol if (. not . parallel ) then rst = - rst end if ! If the angle is pi/2, it is possible for the vectors to point ! in opposite directions but still pass the parallelism test if ( abs ( abs ( rst ) - half_pi ) < tol . and . xy < 0.0d0 ) then ! The vectors point in opposite directions rst = - rst end if end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_kinematics.f90.html"},{"title":"dynamics_linkage.f90 – DYNAMICS","text":"Contents Modules dynamics_linkage Source Code dynamics_linkage.f90 Source Code module dynamics_linkage use iso_fortran_env use dynamics_rigid_bodies use dynamics_kinematics use dynamics_geometry use dynamics_helper use dynamics_quaternions use collections , only : list use ferror , only : errors implicit none private public :: binary_link public :: serial_linkage type , extends ( rigid_body ) :: binary_link !! Defines a link consisting of only two joints. The coordinate system !! of this link is situated at the distal joint with it's z-axis !! coincident with the axis of the joint. The link utilizes a !! Denavit-Hartenberg convention in order to express its geometry. real ( real64 ), public :: link_length !! The link length is the distance between the proximal and distal !! joint axes as measured along the link's x-axis. real ( real64 ), public :: link_twist !! The link twist is the required rotation of the proximal joint !! axis about the link's x-axis to become parallel to the distal !! joint's axis. real ( real64 ), public :: link_offset !! The link offset is the fixed distance between the previous link's !! x-axis and the current link's x-axis as measured along the !! axis of the proximal joint. real ( real64 ), public :: joint_angle !! The joint angle is the required rotation of the previous link's !! x-axis about the proximal joint's axis to become parallel to the !! current link's x-axis. real ( real64 ), public :: joint_type !! The proximal joint type. This value must be either !! REVOLUTE_JOINT or PRISMATIC_JOINT. end type interface binary_link module procedure :: bl_init end interface type serial_linkage !! Defines a serial linkage. type ( list ), private :: m_links contains procedure , public :: get_link_count => sl_get_link_count procedure , public :: get_link => sl_get_link procedure , public :: forward_kinematics => sl_forward_kinematics procedure , public :: jacobian => sl_jacobian procedure , public :: inverse_kinematics => sl_inverse_kinematics_1 end type interface serial_linkage module procedure :: sl_init end interface type serial_linkage_solver_data ! An internal type used as a container to pass data to the inverse ! kinematics solver. type ( serial_linkage ), pointer :: linkage ! The serial_linkage object. real ( real64 ) :: target ( 4 , 4 ) ! The 4-by-4 target transformation matrix. end type contains ! ****************************************************************************** ! BINARY_LINK MEMBERS ! ------------------------------------------------------------------------------ pure function bl_init ( jtype , length , twist , offset , angle , & mass , inertia , cg ) result ( rst ) !! Initializes a new parallel_revolute_revolute_link instance. integer ( int32 ), intent ( in ), optional :: jtype !! The proximal joint type. This value must be either & !! REVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, !! this parameter defaults to REVOLUTE_JOINT. real ( real64 ), intent ( in ), optional :: length !! The link length. If no value is specified, a value of 0 is used. real ( real64 ), intent ( in ), optional :: twist !! The link twist angle. If no value is specified, a value of 0 !! is used. real ( real64 ), intent ( in ), optional :: offset !! The link offset. If no value is specified, a value of 0 is used. real ( real64 ), intent ( in ), optional :: angle !! The joint angle offset. If no value is specified, a value of 0 !! is used. real ( real64 ), intent ( in ), optional :: mass !! The mass of the link. If no value is specified, a value of 1 is !! used. real ( real64 ), intent ( in ), optional :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor. If not specified, an identity matrix !! is used. real ( real64 ), intent ( in ), optional :: cg ( 3 ) !! The x-y-z location of the CG relative to the distal coordinate !! frame, expressed in the link coordinate frame. If not supplied, !! the CG is set to (0, 0, 0) such that it is located at the center !! of the distal joint. type ( binary_link ) :: rst !! The resulting binary_link object. ! Initialize the base object call initialize_rigid_body ( rst , mass , inertia , cg ) ! Additional initialization if ( present ( jtype )) then if ( jtype /= REVOLUTE_JOINT . and . jtype /= PRISMATIC_JOINT ) then rst % joint_type = REVOLUTE_JOINT else rst % joint_type = jtype end if else rst % joint_type = REVOLUTE_JOINT end if if ( present ( length )) then rst % link_length = length else rst % link_length = 0.0d0 end if if ( present ( twist )) then rst % link_twist = twist else rst % link_twist = 0.0d0 end if if ( present ( offset )) then rst % link_offset = offset else rst % link_offset = 0.0d0 end if if ( present ( angle )) then rst % joint_angle = angle else rst % joint_angle = 0.0d0 end if end function ! ****************************************************************************** ! SERIAL_LINKAGE MEMBERS ! ------------------------------------------------------------------------------ function sl_init ( lnks ) result ( rst ) !! Initializes a new serial_linkage object. class ( binary_link ), intent ( in ), dimension (:) :: lnks !! A collection of binary_link objects. The collection starts with !! the first link and progresses to the end-effector in a !! sequential manner. type ( serial_linkage ) :: rst !! The serial_linkage instance. ! Initialization integer ( int32 ) :: i , n n = size ( lnks ) do i = 1 , n call rst % m_links % push ( lnks ( i )) end do end function ! ------------------------------------------------------------------------------ pure function sl_get_link_count ( this ) result ( rst ) !! Gets the number of links in the linkage. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. integer ( int32 ) :: rst !! The link count. rst = this % m_links % count () end function ! ------------------------------------------------------------------------------ function sl_get_link ( this , i ) result ( rst ) !! Gets a pointer to the requested link object. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. integer ( int32 ), intent ( in ) :: i !! The index of the link to retrieve (1 = first link). class ( binary_link ), pointer :: rst !! A pointer to the requested link. ! Process class ( * ), pointer :: ptr ptr => this % m_links % get ( i ) rst => null () select type ( ptr ) class is ( binary_link ) rst => ptr end select end function ! ------------------------------------------------------------------------------ function sl_forward_kinematics ( this , q , err ) result ( rst ) use dynamics_error_handling , only : report_array_size_error !! Computes the forward kinematics for the linkage resulting in a !! transformation matrix between world and end-effector coordinate !! frames. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. real ( real64 ), intent ( in ), dimension (:) :: q !! The array of joint variables. This array must be the same size !! as there are number of links in this linkage. class ( errors ), intent ( inout ), optional , target :: err !! An errors-based object providing error handling in the event the !! array size is incorrect. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: qt , qd , T ( 4 , 4 ) class ( binary_link ), pointer :: lnk class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = this % get_link_count () rst = identity_4 () ! Input Checking if ( size ( q ) /= n ) then call report_array_size_error ( \"sl_forward_kinematics\" , \"q\" , n , & size ( q ), errmgr ) return end if ! Process do i = 1 , n ! Compute the link transformation matrix lnk => this % get_link ( i ) qd = lnk % link_offset qt = lnk % joint_angle if ( lnk % joint_type == PRISMATIC_JOINT ) then qd = qd + q ( i ) else qt = qt + q ( i ) end if T = dh_matrix ( lnk % link_twist , lnk % link_length , qt , qd ) ! Accumulate the transform rst = matmul ( rst , T ) end do end function ! ------------------------------------------------------------------------------ function sl_jacobian ( this , q , err ) result ( rst ) use dynamics_error_handling , only : report_array_size_error !! Constructs the Jacobian matrix for the linkage. The Jacobian matrix !! relates the joint velocities \\dot{\\vec{q}} to the end-effector !! velocity \\dot{\\vec{X}} by \\dot{\\vec{X}} = J \\dot{\\vec{q}}. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. real ( real64 ), intent ( in ), dimension (:) :: q !! The array of joint variables. This array must be the same size !! as there are number of links in this linkage. class ( errors ), intent ( inout ), optional , target :: err !! An errors-based object providing error handling in the event the !! array size is incorrect. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 6-by-N Jacobian matrix where N is the number of !! links in the linkage. ! Parameters real ( real64 ), parameter :: zi_1 ( 4 ) = [ 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 ] ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: qd , qt integer ( int32 ), allocatable , dimension (:) :: jtypes real ( real64 ), allocatable , dimension (:) :: a , alpha , theta , d class ( binary_link ), pointer :: lnk class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = this % get_link_count () ! Error Checking if ( size ( q ) /= n ) then call report_array_size_error ( \"sl_jacobian\" , \"q\" , n , size ( q ), errmgr ) return end if ! Format inputs for the Jacobian calculation allocate ( a ( n ), alpha ( n ), theta ( n ), d ( n ), jtypes ( n )) do i = 1 , n lnk => this % get_link ( i ) qd = lnk % link_offset qt = lnk % joint_angle if ( lnk % joint_type == PRISMATIC_JOINT ) then qd = qd + q ( i ) else qt = qt + q ( i ) end if a ( i ) = lnk % link_length alpha ( i ) = lnk % link_twist theta ( i ) = qt d ( i ) = qd jtypes ( i ) = lnk % joint_type end do ! Compute the Jacobian rst = dh_jacobian ( alpha , a , theta , d , jtypes ) end function ! ------------------------------------------------------------------------------ function sl_inverse_kinematics_1 ( this , qo , trg , ib , err ) result ( rst ) use dynamics_error_handling , only : report_array_size_error !! Solves the inverse kinematics problem for the linkage. class ( serial_linkage ), intent ( in ), target :: this !! The serial_linkage object. real ( real64 ), intent ( in ), dimension (:) :: qo !! An M-element array containing an initial estimate of the M joint !! variables. real ( real64 ), intent ( in ) :: trg ( 4 , 4 ) !! A transformation matrix relating the end-effector coordinate !! frame and the world coordinate frame. This transformation !! matrix defines the end-effector target for the solver. type ( iteration_behavior ), intent ( out ), optional :: ib !! An optional output that can be used to gather information on the !! solver. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object used to retrieve any errors !! regarding the solver. real ( real64 ), allocatable , dimension (:) :: rst !! An M-element array containing the computed joint variables that !! satisfy the constraints. ! Local Variables procedure ( vecfcn ), pointer :: vfcn type ( serial_linkage_solver_data ) :: obj real ( real64 ) :: constraints ( 6 ) class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if vfcn => sl_vecfcn obj % linkage => this obj % target = trg constraints ( 1 : 3 ) = trg ( 1 : 3 , 4 ) constraints ( 4 : 6 ) = 0.0d0 ! Input Check ! Can update this limit after solver and constraint technology improve if ( size ( qo ) > 6 ) then call report_array_size_error ( \"sl_inverse_kinematics_1\" , \"qo\" , 6 , & size ( qo ), errmgr ) return end if ! Process rst = solve_inverse_kinematics ( vfcn , qo , constraints , ib = ib , & args = obj , err = err ) end function ! ---------- subroutine sl_vecfcn ( x , f , args ) !! The subroutine passed to the inverse kinematics solver. real ( real64 ), intent ( in ), dimension (:) :: x !! The N joint variables real ( real64 ), intent ( out ), dimension (:) :: f !! The 6 kinematic constraint equations. class ( * ), intent ( inout ), optional :: args !! A container for the serial_linkage_solver_data object. ! Local Variables real ( real64 ) :: T ( 4 , 4 ), Re ( 3 , 3 ), R ( 3 , 3 ) ! Process select type ( args ) class is ( serial_linkage_solver_data ) ! Compute the forward kinematics of the linkage given the joint ! variables T = args % linkage % forward_kinematics ( x ) ! Evaluate the kinematics equations for position and orientation f ( 1 : 3 ) = T ( 1 : 3 , 4 ) ! The orientation components utilize an angle-axis approximation. ! The idea is to drive these 3 values to 0. Re = transpose ( T ( 1 : 3 , 1 : 3 )) R = matmul ( Re , args % target ( 1 : 3 , 1 : 3 )) f ( 4 ) = 0.5d0 * ( R ( 3 , 2 ) - R ( 2 , 3 )) f ( 5 ) = 0.5d0 * ( R ( 1 , 3 ) - R ( 3 , 1 )) f ( 6 ) = 0.5d0 * ( R ( 2 , 1 ) - R ( 1 , 2 )) end select end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_linkage.f90.html"},{"title":"dynamics_maps.f90 – DYNAMICS","text":"Contents Modules dynamics_maps Source Code dynamics_maps.f90 Source Code module dynamics_maps use iso_fortran_env use dynamics_geometry implicit none private public :: POINCARE_TWO_SIDED public :: POINCARE_ONE_SIDED_FROM_FRONT public :: POINCARE_ONE_SIDED_FROM_BACK public :: poincare_map integer ( int32 ), parameter :: POINCARE_TWO_SIDED = 0 !! A two-sided Poincare section will be computed. In this section, the !! algorithm does not care whether the trajectory approaches the !! sectioning plane from the front or the back of the plane (defined !! by the plane normal). It simply returns any intersection point. integer ( int32 ), parameter :: POINCARE_ONE_SIDED_FROM_FRONT = 1 !! A one-sided Poincare section will be computed where the algorithm !! only retains intersection points where the trajectory approaches !! the sectioning plane from the front (the side of the plane normal). integer ( int32 ), parameter :: POINCARE_ONE_SIDED_FROM_BACK = 2 !! A one-sided Poincare section will be computed where the algorithm !! only retains intersection points where the trajectory approaches !! the sectioning plane from the back (the side opposite the plane !! normal). contains ! ------------------------------------------------------------------------------ pure function poincare_map ( x , y , z , pln , side ) result ( rst ) !! Generates a Poincare map by determining the intersections of the !! supplied trajectory with the specified plane. real ( real64 ), intent ( in ), dimension (:) :: x !! The x-coordinates of the trajectory. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The y-coordinates of the trajectory. real ( real64 ), intent ( in ), dimension ( size ( x )) :: z !! The z-coordinates of the trajectory. class ( plane ), intent ( in ), optional :: pln !! The plane to intersect. If not supplied, the x-y plane is !! utilized where z = 0. integer ( int32 ), intent ( in ), optional :: side !! An integer flag denoting which approach to use when computing !! the section. The acceptable values are as follows. !! !! - POINCARE_TWO_SIDED (Default): A two-sided Poincare section !! will be computed. In this section, the algorithm does not care !! whether the trajectory approaches the sectioning plane from the !! front or the back of the plane (defined by the plane normal). !! It simply returns any intersection point. !! !! - POINCARE_ONE_SIDED_FROM_FRONT: A one-sided Poincare section !! will be computed where the algorithm only retains intersection !! points where the trajectory approaches the sectioning plane from !! the front (the side of the plane normal). !! !! - POINCARE_ONE_SIDED_FROM_BACK: A one-sided Poincare section !! will be computed where the algorithm only retains intersection !! points where the trajectory approaches the sectioning plane from !! the back (the side opposite the plane normal). real ( real64 ), allocatable , dimension (:,:) :: rst !! An N-by-3 matrix containing the x, y, and z coordinates of each !! of the N intersection points in the first, second, and third !! columns respectively. ! Local Variables logical :: from_back integer ( int32 ) :: i , j , n , s real ( real64 ) :: t , pt0 ( 3 ), pt1 ( 3 ), pt2 ( 3 ), v ( 3 ), pt ( 3 ) real ( real64 ), allocatable , dimension (:,:) :: buffer type ( plane ) :: p ! Initialization n = size ( x ) allocate ( buffer ( n , 3 )) if ( present ( pln )) then p = pln else ! XY Plane (point & normal) p = plane ([ 0.0d0 , 0.0d0 , 0.0d0 ], [ 0.0d0 , 0.0d0 , 1.0d0 ]) end if s = POINCARE_TWO_SIDED if ( present ( side )) then if ( side == POINCARE_ONE_SIDED_FROM_BACK ) then s = POINCARE_ONE_SIDED_FROM_BACK else if ( side == POINCARE_ONE_SIDED_FROM_FRONT ) then s = POINCARE_ONE_SIDED_FROM_FRONT end if end if ! Process j = 0 pt1 = [ x ( 1 ), y ( 1 ), z ( 1 )] do i = 2 , n ! Construct a line between the two points pt2 = [ x ( i ), y ( i ), z ( i )] v = pt2 - pt1 ! Determine the intersection with the plane by determining the ! parameter t. If the parameter t lies between 0 and 1 the point ! of intersection is between the two points and we can keep; else, ! it's not and we cannot keep t = - ( p % a * pt1 ( 1 ) + p % b * pt1 ( 2 ) + p % c * pt1 ( 3 ) + p % d ) / & dot_product ( plane_normal ( p ), v ) if ( t >= 0.0d0 . and . t <= 1.0d0 ) then pt = pt1 + t * v if ( s == POINCARE_TWO_SIDED ) then j = j + 1 buffer ( j ,:) = pt else if ( j > 2 ) then from_back = approach_from_behind ( p , pt1 , pt0 ) else from_back = approach_from_behind ( p , pt1 ) end if if ( from_back . and . s == POINCARE_ONE_SIDED_FROM_BACK ) then ! One sided - from back j = j + 1 buffer ( j ,:) = pt else if (. not . from_back . and . s == POINCARE_ONE_SIDED_FROM_FRONT ) then ! One sided - from front j = j + 1 buffer ( j ,:) = pt end if end if end if ! Update the next point pt0 = pt1 pt1 = pt2 end do rst = buffer ( 1 : j ,:) end function ! ------------------------------------------------------------------------------ pure function approach_from_behind ( pln , x1 , x2 ) result ( rst ) !! Determines if the trajectory approaches the sectioning plane from !! behind (true) or not (false) given the most recent point in the !! trajectory and the point prior. The point prior. class ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ), intent ( in ) :: x1 ( 3 ) !! The most recent point in the trajectory prior to the trajectory !! intersecting the plane. real ( real64 ), intent ( in ), optional :: x2 ( 3 ) !! The point previos to x1 that is used only if x1 lies on the plane !! such that direction is indeterminate. logical :: rst !! Returns true if the trajectory approaches the plane from behind; !! else, false if the trajectory approaches the plane from in front. ! Local Variables real ( real64 ) :: val , tol ! Initialization tol = 1.0d1 * epsilon ( tol ) ! tolerance for a point on the plane ! Process val = pln % a * x1 ( 1 ) + pln % b * x1 ( 2 ) + pln % c * x1 ( 3 ) + pln % d if ( abs ( val ) < tol ) then ! The point lies on the plane if ( present ( x2 )) then ! Use the point previous to determine which side val = pln % a * x2 ( 1 ) + pln % b * x2 ( 2 ) + pln % c * x2 ( 3 ) + pln % d rst = val < 0.0d0 else rst = . false . ! default to this case in the event x2 is not given end if else rst = val < 0.0d0 ! the point approaches the plane from the side ! opposite the normal (from behind) if true end if end function ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_maps.f90.html"},{"title":"dynamics_quaternions.f90 – DYNAMICS","text":"Contents Modules dynamics_quaternions Source Code dynamics_quaternions.f90 Source Code module dynamics_quaternions use iso_fortran_env implicit none private public :: quaternion public :: operator ( + ) public :: operator ( - ) public :: operator ( * ) public :: operator ( / ) public :: assignment ( = ) public :: operator ( ** ) public :: abs public :: conjg public :: real public :: aimag public :: inverse public :: exp public :: log public :: dot_product type quaternion !! Defines a quaternion of the form: real ( real64 ) :: w !! The real component of the quaternion. real ( real64 ) :: x !! The first element in the imaginary component of the quaternion. real ( real64 ) :: y !! The second element in the imaginary component of the quaternion. real ( real64 ) :: z !! The third element in the imaginary component of the quaternion. contains procedure , public :: to_matrix => quat_to_matrix procedure , public :: normalize => quat_normalize procedure , public :: to_array => quat_to_vec4 procedure , public :: to_angle_axis => quat_to_angle_axis procedure , public :: to_roll_pitch_yaw => quat_to_rpy end type interface quaternion module procedure :: quat_init_array module procedure :: quat_init_angle_axis module procedure :: quat_init_mtx end interface interface operator ( + ) module procedure :: quat_add end interface interface operator ( - ) module procedure :: quat_subtract module procedure :: quat_negate end interface interface operator ( * ) module procedure :: quat_scalar_mult module procedure :: scalar_quat_mult module procedure :: quat_multiply module procedure :: quat_vec3_mult end interface interface operator ( / ) module procedure :: quat_scalar_div module procedure :: quat_divide end interface interface assignment ( = ) module procedure :: quat_assign module procedure :: quat_assign_vec4 end interface interface operator ( ** ) module procedure :: quat_pwr module procedure :: quat_int_pwr end interface interface abs module procedure :: quat_abs end interface interface conjg module procedure :: quat_conjg end interface interface real module procedure :: quat_real end interface interface aimag module procedure :: quat_aimag end interface interface exp module procedure :: quat_exp end interface interface log module procedure :: quat_log end interface interface dot_product module procedure :: quat_dot_prd end interface contains ! ------------------------------------------------------------------------------ pure function quat_init_array ( x ) result ( rst ) !! Constructs a quaternion from a 4-element array stored such that !! [w, x, y, z]. real ( real64 ), intent ( in ), dimension ( 4 ) :: x !! The array from which to initialize the quaternion stored in the !! order [w, x, y, z]. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x ( 1 ) rst % x = x ( 2 ) rst % y = x ( 3 ) rst % z = x ( 4 ) end function ! ------------------------------------------------------------------------------ pure function quat_init_angle_axis ( angle , axis ) result ( rst ) !! Constructs a quaternion given an axis and the angle of rotation about !! the axis. real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ), intent ( in ), dimension ( 3 ) :: axis !! A 3-element vector defining the axis about which the rotation !! occurrs. type ( quaternion ) :: rst !! The resulting quaternion. real ( real64 ) :: s s = sin ( 0.5d0 * angle ) rst % w = cos ( 0.5d0 * angle ) rst % x = s * axis ( 1 ) rst % y = s * axis ( 2 ) rst % z = s * axis ( 3 ) end function ! ------------------------------------------------------------------------------ pure function quat_init_mtx ( r ) result ( rst ) !! Constructs a quaternion from a 3-by-3 rotation matrix using the !! Stanley method. real ( real64 ), intent ( in ), dimension ( 3 , 3 ) :: r !! The rotation matrix. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables integer ( int32 ) :: ind real ( real64 ) :: esq ( 4 ), e0 , e1 , e2 , e3 ! Process esq ( 1 ) = 0.25d0 * ( 1.0d0 + r ( 1 , 1 ) + r ( 2 , 2 ) + r ( 3 , 3 )) esq ( 2 ) = 0.25d0 * ( 1.0d0 + r ( 1 , 1 ) - r ( 2 , 2 ) - r ( 3 , 3 )) esq ( 3 ) = 0.25d0 * ( 1.0d0 - r ( 1 , 1 ) + r ( 2 , 2 ) - r ( 3 , 3 )) esq ( 4 ) = 0.25d0 * ( 1.0d0 - r ( 1 , 1 ) - r ( 2 , 2 ) + r ( 3 , 3 )) ind = maxloc ( esq , 1 ) select case ( ind ) case ( 1 ) e0 = sqrt ( esq ( 1 )) e1 = 0.25d0 * ( r ( 3 , 2 ) - r ( 2 , 3 )) / e0 e2 = 0.25d0 * ( r ( 1 , 3 ) - r ( 3 , 1 )) / e0 e3 = 0.25d0 * ( r ( 2 , 1 ) - r ( 1 , 2 )) / e0 case ( 2 ) e1 = sqrt ( esq ( 2 )) e0 = 0.25d0 * ( r ( 3 , 2 ) - r ( 2 , 3 )) / e1 e2 = 0.25d0 * ( r ( 1 , 2 ) + r ( 2 , 1 )) / e1 e3 = 0.25d0 * ( r ( 1 , 3 ) + r ( 3 , 1 )) / e1 case ( 3 ) e2 = sqrt ( esq ( 3 )) e0 = 0.25d0 * ( r ( 1 , 3 ) - r ( 3 , 1 )) / e2 e1 = 0.25d0 * ( r ( 1 , 2 ) + r ( 2 , 1 )) / e2 e3 = 0.25d0 * ( r ( 2 , 3 ) + r ( 3 , 2 )) / e2 case default e3 = sqrt ( esq ( 4 )) e0 = 0.25d0 * ( r ( 2 , 1 ) - r ( 1 , 2 )) / e3 e1 = 0.25d0 * ( r ( 1 , 3 ) + r ( 3 , 1 )) / e3 e2 = 0.25d0 * ( r ( 2 , 3 ) + r ( 3 , 2 )) / e3 end select rst % w = e0 rst % x = e1 rst % y = e2 rst % z = e3 end function ! ------------------------------------------------------------------------------ pure elemental function quat_add ( x , y ) result ( rst ) !! Adds two quaternions together. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x % w + y % w rst % x = x % x + y % x rst % y = x % y + y % y rst % z = x % z + y % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_subtract ( x , y ) result ( rst ) !! Subtracts two quaternions. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x % w - y % w rst % x = x % x - y % x rst % y = x % y - y % y rst % z = x % z - y % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_scalar_mult ( x , y ) result ( rst ) !! Multiplies a quaternion with a scalar. type ( quaternion ), intent ( in ) :: x !! The quaternion. real ( real64 ), intent ( in ) :: y !! The scalar. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = y * x % w rst % x = y * x % x rst % y = y * x % y rst % z = y * x % z end function ! ------------------------------------------------------------------------------ pure elemental function scalar_quat_mult ( x , y ) result ( rst ) !! Multiplies a quaternion with a scalar. real ( real64 ), intent ( in ) :: x !! The scalar. type ( quaternion ), intent ( in ) :: y !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x * y % w rst % x = x * y % x rst % y = x * y % y rst % z = x * y % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_multiply ( x , y ) result ( rst ) !! Multiplies two quaternions. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: x0 , x1 , x2 , x3 , y0 , y1 , y2 , y3 ! Initialization x0 = x % w x1 = x % x x2 = x % y x3 = x % z y0 = y % w y1 = y % x y2 = y % y y3 = y % z ! Process rst % w = x0 * y0 - x1 * y1 - x2 * y2 - x3 * y3 rst % x = y0 * x1 + y1 * x0 - y2 * x3 + y3 * x2 rst % y = y0 * x2 + x0 * y2 + y1 * x3 - x1 * y3 rst % z = y0 * x3 - y1 * x2 + x0 * y3 + y2 * x1 end function ! ------------------------------------------------------------------------------ pure function quat_vec3_mult ( x , y ) result ( rst ) !! Multiplies a quaternion with a 3-element vector. type ( quaternion ), intent ( in ) :: x !! The quaternion. real ( real64 ), intent ( in ), dimension ( 3 ) :: y !! The vector. type ( quaternion ) :: rst !! The resulting quaternion. rst = x * quaternion ([ 0.0d0 , y ( 1 ), y ( 2 ), y ( 3 )]) end function ! ------------------------------------------------------------------------------ pure elemental function quat_scalar_div ( x , y ) result ( rst ) !! Divides a quaternion by a scalar. type ( quaternion ), intent ( in ) :: x !! The quaternion. real ( real64 ), intent ( in ) :: y !! The scalar. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x % w / y rst % x = x % x / y rst % y = x % y / y rst % z = x % z / y end function ! ------------------------------------------------------------------------------ pure elemental function quat_divide ( x , y ) result ( rst ) !! Divides a quaternion by another. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. rst = x * inverse ( y ) end function ! ------------------------------------------------------------------------------ pure elemental subroutine quat_assign ( x , y ) !! Assigns a quaternion to another. type ( quaternion ), intent ( out ) :: x !! The resulting quaternion. type ( quaternion ), intent ( in ) :: y !! The source quaternion. x % w = y % w x % x = y % x x % y = y % y x % z = y % z end subroutine ! ------------------------------------------------------------------------------ pure subroutine quat_assign_vec4 ( x , y ) !! Assigns a 4-element vector to a quaternion. type ( quaternion ), intent ( out ) :: x !! The resulting quaternion. real ( real64 ), intent ( in ), dimension ( 4 ) :: y !! The source vector. x % w = y ( 1 ) x % x = y ( 2 ) x % y = y ( 3 ) x % z = y ( 4 ) end subroutine ! ------------------------------------------------------------------------------ pure elemental function quat_negate ( x ) result ( rst ) !! Negates a quaternion. type ( quaternion ), intent ( in ) :: x !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = - x % w rst % x = - x % x rst % y = - x % y rst % z = - x % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_abs ( q ) result ( rst ) !! Computes the magnitude of a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ) :: rst !! The magnitude of the quaternion. real ( real64 ) :: x ( 4 ) x = [ q % w , q % x , q % y , q % z ] rst = norm2 ( x ) end function ! ------------------------------------------------------------------------------ pure elemental function quat_conjg ( q ) result ( rst ) !! Computes the conjugate of a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The conjugate of the quaternion. rst % w = q % w rst % x = - q % x rst % y = - q % y rst % z = - q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_real ( q ) result ( rst ) !! Returns the real component of the quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ) :: rst !! The real component. rst = q % w end function ! ------------------------------------------------------------------------------ pure function quat_aimag ( q ) result ( rst ) !! Returns the imaginary component of the quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), dimension ( 3 ) :: rst !! The imaginary component as a vector. rst = [ q % x , q % y , q % z ] end function ! ------------------------------------------------------------------------------ pure elemental function inverse ( q ) result ( rst ) !! Computes the inverse of a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The inverse of the supplied quaternion. rst = conjg ( q ) / ( abs ( q ) ** 2 ) end function ! ------------------------------------------------------------------------------ pure elemental function quat_exp ( q ) result ( rst ) !! Evaluates the exponential function for a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: qmag , arg , s ! Process qmag = norm2 ( aimag ( q )) arg = exp ( q % w ) s = arg * sin ( qmag ) / qmag rst % w = arg * cos ( qmag ) rst % x = s * q % x rst % y = s * q % y rst % z = s * q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_log ( q ) result ( rst ) !! Evalautes the natural logarithm function for a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: qmag , vmag , arg ! Process qmag = abs ( q ) vmag = norm2 ( aimag ( q )) arg = acos ( q % w / qmag ) / vmag rst % w = log ( qmag ) rst % x = arg * q % x rst % y = arg * q % y rst % z = arg * q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_pwr ( q , exponent ) result ( rst ) !! Computes the result of a quaternion raised to an exponent. type ( quaternion ), intent ( in ) :: q !! The quaternion base. real ( real64 ), intent ( in ) :: exponent !! The exponent. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: qmag , vmag , phi , arg , s ! Process qmag = abs ( q ) vmag = norm2 ( aimag ( q )) phi = acos ( q % w / qmag ) arg = qmag ** exponent s = arg * sin ( exponent * phi ) / vmag rst % w = arg * cos ( exponent * phi ) rst % x = s * q % x rst % y = s * q % y rst % z = s * q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_int_pwr ( q , exponent ) result ( rst ) !! Computes the result of a quaternion raised to an exponent. type ( quaternion ), intent ( in ) :: q !! The quaternion base. integer ( int32 ), intent ( in ) :: exponent !! The exponent. type ( quaternion ) :: rst !! The resulting quaternion. rst = quat_pwr ( q , real ( exponent , real64 )) end function ! ------------------------------------------------------------------------------ pure elemental function quat_dot_prd ( x , y ) result ( rst ) !! Computes the dot product of two quaternions. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. real ( real64 ) :: rst !! The dot product. rst = x % w * y % w + x % x * y % x + x % y * y % y + x % z * y % z end function ! ****************************************************************************** ! MEMBER ROUTINES ! ------------------------------------------------------------------------------ pure function quat_to_matrix ( q ) result ( rst ) !! Converts the quaternion to a 3-by-3 rotation matrix. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), dimension ( 3 , 3 ) :: rst !! The resulting rotation matrix. ! Local Variables type ( quaternion ) :: qnorm real ( real64 ) :: e0 , e1 , e2 , e3 ! Process qnorm = q / abs ( q ) e0 = qnorm % w e1 = qnorm % x e2 = qnorm % y e3 = qnorm % z rst ( 1 , 1 ) = e0 ** 2 + e1 ** 2 - e2 ** 2 - e3 ** 2 rst ( 2 , 1 ) = 2.0d0 * ( e0 * e3 + e1 * e2 ) rst ( 3 , 1 ) = 2.0d0 * ( e1 * e3 - e0 * e2 ) rst ( 1 , 2 ) = 2.0d0 * ( e1 * e2 - e0 * e3 ) rst ( 2 , 2 ) = e0 ** 2 - e1 ** 2 + e2 ** 2 - e3 ** 2 rst ( 3 , 2 ) = 2.0d0 * ( e0 * e1 + e2 * e3 ) rst ( 1 , 3 ) = 2.0d0 * ( e0 * e2 + e1 * e3 ) rst ( 2 , 3 ) = 2.0d0 * ( e2 * e3 - e0 * e1 ) rst ( 3 , 3 ) = e0 ** 2 - e1 ** 2 - e2 ** 2 + e3 ** 2 end function ! ------------------------------------------------------------------------------ pure subroutine quat_normalize ( q ) !! Normalizes the quaternion. class ( quaternion ), intent ( inout ) :: q !! On input, the quaternion to normalize. On output, the normalized !! quaternion. ! Local Variables real ( real64 ) :: mag ! Process mag = abs ( q ) q % w = q % w / mag q % x = q % x / mag q % y = q % y / mag q % z = q % z / mag end subroutine ! ------------------------------------------------------------------------------ pure function quat_to_vec4 ( q ) result ( rst ) !! Converts a quaternion to a 4-element array of the form [w, x, y, z]. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), dimension ( 4 ) :: rst !! The array of the form [w, x, y, z]. rst = [ q % w , q % x , q % y , q % z ] end function ! ------------------------------------------------------------------------------ pure subroutine quat_to_angle_axis ( q , angle , axis ) !! Converts the quaternion to the equivalent angle-axis form. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), intent ( out ) :: angle !! The rotation angle, in radians. real ( real64 ), intent ( out ) :: axis ( 3 ) !! The axis of rotation. ! Process real ( real64 ) :: qnorm , enorm qnorm = abs ( q ) enorm = norm2 ( aimag ( q )) axis = aimag ( q ) / enorm angle = 2.0d0 * atan2 ( enorm , q % w / qnorm ) end subroutine ! ------------------------------------------------------------------------------ pure subroutine quat_to_rpy ( q , roll , pitch , yaw ) !! Converts the quaternion to the equivalent Euler angles of roll, !! pitch, and yaw. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), intent ( out ) :: roll !! The roll angle (rotation about the body x-axis), in radians. real ( real64 ), intent ( out ) :: pitch !! The pitch angle (rotation about the body y-axis), in radians. real ( real64 ), intent ( out ) :: yaw !! The yaw angle (rotation about the body z-axis), in radians. ! Local Variables real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) real ( real64 ) :: qmag , qx , qy , qz , qw ! Process qmag = abs ( q ) qw = q % w / qmag qx = q % x / qmag qy = q % y / qmag qz = q % z / qmag roll = atan2 ( 2.0d0 * ( qw * qx + qy * qz ), 1.0d0 - 2.0d0 * ( qx ** 2 + qy ** 2 )) pitch = - 0.5d0 * pi + 2.0d0 * & atan2 ( sqrt ( 1.0d0 + 2.0d0 * ( qw * qy - qx * qz )), & sqrt ( 1.0d0 - 2.0d0 * ( qw * qy - qx * qz ))) yaw = atan2 ( 2.0d0 * ( qw * qz + qx * qy ), 1.0d0 - 2.0d0 * ( qy ** 2 + qz ** 2 )) end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_quaternions.f90.html"},{"title":"dynamics_rigid_bodies.f90 – DYNAMICS","text":"Contents Modules dynamics_rigid_bodies Source Code dynamics_rigid_bodies.f90 Source Code module dynamics_rigid_bodies use iso_fortran_env implicit none private public :: rigid_body public :: initialize_rigid_body type rigid_body !! Defines a rigid body. real ( real64 ), public :: mass !! The mass of the body. real ( real64 ), public :: cg ( 3 ) !! The x-y-z location of the CG relative to the body coordinate !! frame. real ( real64 ), public :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor as measured about the CG of the body. end type interface rigid_body module procedure :: rb_init end interface contains ! ------------------------------------------------------------------------------ pure function rb_init ( m , inertia , cg ) result ( rst ) !! Initializes a rigid_body object. real ( real64 ), intent ( in ), optional :: m !! The mass of the body. If no mass is specified, a value of 1 is used. real ( real64 ), intent ( in ), optional :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor. If not supplied, an identity matrix !! is used. real ( real64 ), intent ( in ), optional :: cg ( 3 ) !! The x-y-z location of the CG relative to the body coordinate frame. !! If not supplied, the CG is set to (0, 0, 0). type ( rigid_body ) :: rst !! The rigid_body object. call initialize_rigid_body ( rst , m , inertia , cg ) end function ! ------------------------------------------------------------------------------ pure subroutine initialize_rigid_body ( bdy , m , inertia , cg ) !! Initializes a rigid_body object. class ( rigid_body ), intent ( inout ) :: bdy !! The rigid_body object. real ( real64 ), intent ( in ), optional :: m !! The mass of the body. If no mass is specified, a value of 1 is used. real ( real64 ), intent ( in ), optional :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor. If not supplied, an identity matrix !! is used. real ( real64 ), intent ( in ), optional :: cg ( 3 ) !! The x-y-z location of the CG relative to the body coordinate frame. !! If not supplied, the CG is set to (0, 0, 0). if ( present ( m )) then bdy % mass = m else bdy % mass = 1.0d0 end if if ( present ( inertia )) then bdy % inertia = inertia else bdy % inertia = reshape ( & [ 1.0d0 , 0.0d0 , 0.0d0 , & 0.0d0 , 1.0d0 , 0.0d0 , & 0.0d0 , 0.0d0 , 1.0d0 ], & [ 3 , 3 ] & ) end if if ( present ( cg )) then bdy % cg = cg else bdy % cg = 0.0d0 end if end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_rigid_bodies.f90.html"},{"title":"dynamics_rotation.f90 – DYNAMICS","text":"Contents Modules dynamics_rotation Source Code dynamics_rotation.f90 Source Code module dynamics_rotation use iso_fortran_env use dynamics_helper implicit none private public :: rotate_x public :: rotate_y public :: rotate_z public :: rotate public :: acceleration_transform public :: velocity_transform public :: to_angle_axis interface rotate module procedure :: rotate_general_1 module procedure :: rotate_general_2 end interface contains ! ------------------------------------------------------------------------------ pure function rotate_x ( angle ) result ( rst ) !! Constructs the rotation matrix describing a rotation about an !! x-axis such that !! \\overrightarrow{r_2} = \\textbf{R}_x \\overrightarrow{r_1} . !! !! \\textbf{R}_x = \\left[ \\begin{matrix} 1 & 0 & 0 \\\\ 0 & !! \\cos{\\theta_x} & -\\sin{\\theta_x} \\\\ 0 & \\sin{\\theta_x} & !! \\cos{\\theta_x} \\\\ \\end{matrix} \\right] real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. ! Local Variables real ( real64 ) :: c , s ! Process c = cos ( angle ) s = sin ( angle ) rst = reshape ([ 1.0d0 , 0.0d0 , 0.0d0 , 0.0d0 , c , s , 0.0d0 , - s , c ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function rotate_y ( angle ) result ( rst ) !! Constructs the rotation matrix describing a rotation about a y-axis !! such that !! \\overrightarrow{r_2} = \\textbf{R}_y \\overrightarrow{r_1} . !! !! \\textbf{R}_y = \\left[ \\begin{matrix} \\cos{\\theta_y} & 0 & !! \\sin{\\theta_y} \\\\ 0 & 1 & 0 \\\\ -\\sin{\\theta_y} & 0 & !! \\cos{\\theta_y} \\\\ \\end{matrix} \\right] real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. ! Local Variables real ( real64 ) :: c , s ! Process c = cos ( angle ) s = sin ( angle ) rst = reshape ([ c , 0.0d0 , - s , 0.0d0 , 1.0d0 , 0.0d0 , s , 0.0d0 , c ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function rotate_z ( angle ) result ( rst ) !! Constructs the rotation matrix describing a rotation about a y-axis !! such that !! \\overrightarrow{r_2} = \\textbf{R}_z \\overrightarrow{r_1} . !! !! \\textbf{R}_z = \\left[ \\begin{matrix} \\cos{\\theta_z} & !! -\\sin{\\theta_z} & 0 \\\\ \\sin{\\theta_z} & \\cos{\\theta_z} & 0 \\\\ !! 0 & 0 & 1 \\\\ \\end{matrix} \\right] real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. ! Local Variables real ( real64 ) :: c , s ! Process c = cos ( angle ) s = sin ( angle ) rst = reshape ([ c , s , 0.0d0 , - s , c , 0.0d0 , 0.0d0 , 0.0d0 , 1.0d0 ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function rotate_general_1 ( i , j , k , Ip , Jp , Kp ) result ( rst ) !! Constructs a rotation matrix when the orientation of the coordinate !! frame of interest is known relative to the parent coordinate frame. !! !! The matrix is of the following form. !! !! \\textbf{R} = \\left[ \\begin{matrix} !! \\vec{I_p} \\cdot \\vec{i} & \\vec{I_p} \\cdot \\vec{j} & !! \\vec{I_p} \\cdot \\vec{k} \\\\ \\vec{J_p} \\cdot \\vec{i} & !! \\vec{J_p} \\cdot \\vec{j} & \\vec{J_p} \\cdot \\vec{k} \\\\ !! \\vec{K_p} \\cdot \\vec{i} & \\vec{K_p} \\cdot \\vec{j} & !! \\vec{K_p} \\cdot \\vec{k} \\\\ \\end{matrix} \\right] !! !! This routine does not check for orthogonallity or unit vector length; !! therefore, to ensure correct results it is the callers responsibility !! to ensure each vector is of unit length and that the unit vectors !! are properly orthogonal. real ( real64 ), intent ( in ) :: i ( 3 ) !! The rotated coordinate frame x-axis unit vector. real ( real64 ), intent ( in ) :: j ( 3 ) !! The rotated coordinate frame y-axis unit vector. real ( real64 ), intent ( in ) :: k ( 3 ) !! The rotated coordinate frame z-axis unit vector. real ( real64 ), intent ( in ) :: Ip ( 3 ) !! The parent coordinate frame x-axis unit vector. real ( real64 ), intent ( in ) :: Jp ( 3 ) !! The parent coordinate frame y-axis unit vector. real ( real64 ), intent ( in ) :: Kp ( 3 ) !! The parent coordinate frame z-axis unit vector. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. rst ( 1 , 1 ) = dot_product ( Ip , i ) rst ( 2 , 1 ) = dot_product ( Jp , i ) rst ( 3 , 1 ) = dot_product ( Kp , i ) rst ( 1 , 2 ) = dot_product ( Ip , j ) rst ( 2 , 2 ) = dot_product ( Jp , j ) rst ( 3 , 2 ) = dot_product ( Kp , j ) rst ( 1 , 3 ) = dot_product ( Ip , k ) rst ( 2 , 3 ) = dot_product ( Jp , k ) rst ( 3 , 3 ) = dot_product ( Kp , k ) end function ! ------------------------------------------------------------------------------ pure function rotate_general_2 ( i , j , k ) result ( rst ) !! Constructs a rotation matrix when the orientation of the coordinate !! frame of interest is known relative to the parent coordinate frame. !! !! The matrix is of the following form. !! !! \\textbf{R} = \\left[ \\begin{matrix} !! \\vec{I_p} \\cdot \\vec{i} & \\vec{I_p} \\cdot \\vec{j} & !! \\vec{I_p} \\cdot \\vec{k} \\\\ \\vec{J_p} \\cdot \\vec{i} & !! \\vec{J_p} \\cdot \\vec{j} & \\vec{J_p} \\cdot \\vec{k} \\\\ !! \\vec{K_p} \\cdot \\vec{i} & \\vec{K_p} \\cdot \\vec{j} & !! \\vec{K_p} \\cdot \\vec{k} \\\\ \\end{matrix} \\right] !! !! The parent coordinate frame is assumed to be as follows. !! !! \\vec{I_p} = \\left( \\begin{matrix} 1 & 0 & 0 \\end{matrix} \\right) !! !! \\vec{J_p} = \\left( \\begin{matrix} 0 & 1 & 0 \\end{matrix} \\right) !! !! \\vec{K_p} = \\left( \\begin{matrix} 0 & 0 & 1 \\end{matrix} \\right) !! !! This routine does not check for orthogonallity or unit vector length; !! therefore, to ensure correct results it is the callers responsibility !! to ensure each vector is of unit length and that the unit vectors !! are properly orthogonal. real ( real64 ), intent ( in ) :: i ( 3 ) !! The rotated coordinate frame x-axis unit vector. real ( real64 ), intent ( in ) :: j ( 3 ) !! The rotated coordinate frame y-axis unit vector. real ( real64 ), intent ( in ) :: k ( 3 ) !! The rotated coordinate frame z-axis unit vector. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. rst = rotate_general_1 ( i , j , k , [ 1.0d0 , 0.0d0 , 0.0d0 ], & [ 0.0d0 , 1.0d0 , 0.0d0 ], [ 0.0d0 , 0.0d0 , 1.0d0 ]) end function ! ------------------------------------------------------------------------------ pure subroutine to_angle_axis ( r , angle , axis ) !! Extracts the equivalent rotation angle and axis of rotation given a !! 3-by-3 rotation matrix. real ( real64 ), intent ( in ) :: r ( 3 , 3 ) !! The 3-by-3 rotation matrix. real ( real64 ), intent ( out ) :: angle !! The rotation angle. real ( real64 ), intent ( out ) :: axis ( 3 ) !! The axis of rotation. ! Process real ( real64 ) :: u ( 3 , 3 ) angle = acos ( 0.5d0 * ( r ( 1 , 1 ) + r ( 2 , 2 ) + r ( 3 , 3 ) - 1.0d0 )) u = ( r - transpose ( r )) / ( 2.0d0 * sin ( angle )) ! this is skew symmetric axis = [ u ( 3 , 2 ), u ( 1 , 3 ), u ( 2 , 1 )] axis = axis / norm2 ( axis ) ! normalize to a unit vector end subroutine ! ****************************************************************************** ! REVISION 1.0.8 ADDITIONS ! ------------------------------------------------------------------------------ pure function acceleration_transform ( alpha , omega , a , x ) result ( rst ) !! Computes the acceleration transformation matrix relating the !! position of a point expressed in a rotating and translating body !! relative to its parent frame. !! !! The transformation matrix takes the following form. !! !! A = \\left[ \\begin{matrix} \\tilde{\\alpha} - \\tilde{\\omega} !! \\tilde{\\omega}^{T} & \\vec{a} - \\left( \\tilde{\\alpha} - \\tilde{\\omega} !! \\tilde{\\omega}^{T} \\right) \\vec{x} \\\\ 0 & 0 \\end{matrix} \\right] !! !! where, !! !! \\tilde{\\alpha} = \\left[ \\begin{matrix} 0 & -\\alpha_z & \\alpha_y \\\\ !! \\alpha_z & 0 & -\\alpha_x \\\\ -\\alpha_y & \\alpha_x & 0 \\end{matrix} !! \\right] !! !! and, !! !! \\tilde{\\omega} = \\left[ \\begin{matrix} 0 & -\\omega_z & \\omega_y \\\\ !! \\omega_z & 0 & -\\omega_x \\\\ -\\omega_y & \\omega_x & 0 \\end{matrix} !! \\right] !! !! Given a vector describing the location on a moving body, !! \\vec{r_p}, the matrix is used to report its acceleration !! \\vec{a_p} = A \\vec{r_p}. real ( real64 ), intent ( in ) :: alpha ( 3 ) !! The angular acceleration vector. real ( real64 ), intent ( in ) :: omega ( 3 ) !! The angular velocity vector. real ( real64 ), intent ( in ) :: a ( 3 ) !! The translational acceleration vector describing the acceleration !! of the body in its parent coordinate frame. real ( real64 ), intent ( in ) :: x ( 3 ) !! The position vector of the body in its parent coordinate frame. real ( real64 ) :: rst ( 4 , 4 ) !! The 4-by-4 transformation matrix. ! Compute alpha = alpha - omega * omega**T rst ( 1 , 1 ) = - omega ( 3 ) ** 2 - omega ( 2 ) ** 2 rst ( 2 , 1 ) = omega ( 1 ) * omega ( 2 ) + alpha ( 3 ) rst ( 3 , 1 ) = omega ( 1 ) * omega ( 3 ) - alpha ( 2 ) rst ( 4 , 1 ) = 0.0d0 rst ( 1 , 2 ) = omega ( 1 ) * omega ( 2 ) - alpha ( 3 ) rst ( 2 , 2 ) = - omega ( 3 ) ** 2 - omega ( 1 ) ** 2 rst ( 3 , 2 ) = omega ( 2 ) * omega ( 3 ) + alpha ( 1 ) rst ( 4 , 2 ) = 0.0d0 rst ( 1 , 3 ) = omega ( 1 ) * omega ( 3 ) + alpha ( 2 ) rst ( 2 , 3 ) = omega ( 2 ) * omega ( 3 ) - alpha ( 1 ) rst ( 3 , 3 ) = - omega ( 2 ) ** 2 - omega ( 1 ) ** 2 rst ( 4 , 3 ) = 0.0d0 ! Compute a - (alpha - omega * omega**T) x rst ( 1 : 3 , 4 ) = a - matmul ( rst ( 1 : 3 , 1 : 3 ), x ) rst ( 4 , 4 ) = 0.0d0 end function ! ------------------------------------------------------------------------------ pure function velocity_transform ( omega , v , x ) result ( rst ) !! Computes the velocity transformation matrix relating the position !! of a point expressed in a rotating and translating body relative to !! its parent frame. !! !! The transformation matrix takes the following form. !! !! V = \\left[ \\begin{matrix} \\tilde{\\omega} & \\vec{v} - !! \\tilde{\\omega} \\vec{x} \\\\ 0 & 0 \\end{matrix} \\right] !! !! where, !! !! \\tilde{\\omega} = \\left[ \\begin{matrix} 0 & -\\omega_z & \\omega_y \\\\ !! \\omega_z & 0 & -\\omega_x \\\\ -\\omega_y & \\omega_x & 0 \\end{matrix} !! \\right] !! !! Given a vector describing the location on a moving body, !! \\vec{r_p}, the matrix is used to report its velocity !! \\vec{v_p} = V \\vec{r_p}. real ( real64 ), intent ( in ) :: omega ( 3 ) !! The angular velocity vector. real ( real64 ), intent ( in ) :: v ( 3 ) !! The translation velocity vector describing the velocity of the !! body in its parent coordinate frame. real ( real64 ), intent ( in ) :: x ( 3 ) !! The position vector of the body in its parent coordinate frame. real ( real64 ) :: rst ( 4 , 4 ) !! The 4-by-4 transformation matrix. ! Process rst ( 1 : 3 , 1 : 3 ) = to_skew_symmetric ( omega ) rst ( 1 : 3 , 4 ) = v - matmul ( rst ( 1 : 3 , 1 : 3 ), x ) rst ( 4 ,:) = 0.0d0 end function end module","tags":"","loc":"sourcefile\\dynamics_rotation.f90.html"},{"title":"dynamics_stability.f90 – DYNAMICS","text":"Contents Modules dynamics_stability Source Code dynamics_stability.f90 Source Code module dynamics_stability use iso_fortran_env use ferror use dynamics_error_handling use linalg , only : eigen implicit none private public :: HYPERBOLIC_FIXED_POINT_SINK public :: HYPERBOLIC_FIXED_POINT_SOURCE public :: HYPERBOLIC_FIXED_POINT_SADDLE public :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE public :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE public :: NONHYPERBOLIC_FIXED_POINT_CENTER public :: determine_local_stability integer ( int32 ), parameter :: HYPERBOLIC_FIXED_POINT_SINK = 100 !! Describes a hyperbolic fixed point where all of the eigenvalues of !! the dynamics matrix have a nonzero real part and all real parts are !! negative-valued. This point is considered stable. integer ( int32 ), parameter :: HYPERBOLIC_FIXED_POINT_SOURCE = 101 !! Describes a hyperbolic fixed point where all of the eigenvalues of !! the dynamics matrix have a nonzero real part and the real !! part is positive-valued for each. This point is considered unstable. integer ( int32 ), parameter :: HYPERBOLIC_FIXED_POINT_SADDLE = 102 !! Describes a hyperbolic fixed point where all of the eigenvalues of !! the dynamics matrix have a nonzero real part but one or more of the !! eigenvalues has a positive-valued real part. integer ( int32 ), parameter :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE = 103 !! Describes a nonhyperbolic fixed point where one or more of the !! eigenvalues of the dynamics matrix have a positive-valued real part. integer ( int32 ), parameter :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE = 104 !! Describes a nonhyperbolic fixed point where some of the eigenvalues !! of the dynamics matrix have negative real parts and the remaining !! eigenvalues all have zero-valued real parts. integer ( int32 ), parameter :: NONHYPERBOLIC_FIXED_POINT_CENTER = 105 !! Describes a nonhyperbolic fixed point where all of the eigenvalues !! of the dynamics matrix are purely imaginary and nonzero. This point !! is considered stable. contains ! ------------------------------------------------------------------------------ function determine_local_stability ( a , ev , err ) result ( rst ) !! Determines the nature of stability/unstability near the point at which !! the dynamics matrix was computed. real ( real64 ), intent ( in ), dimension (:,:) :: a !! An N-by-N matrix containing the 'A' matrix, also known as the !! dynamics matrix. complex ( real64 ), intent ( out ), optional , dimension (:) :: ev !! An optional N-element array that, if supplied, will be filled with !! the eigenvalues of the matrix A. class ( errors ), intent ( inout ), optional , target :: err !! An error handler object. integer ( int32 ) :: rst !! Describe the output constants ! Local Variables logical :: hyperbolic integer ( int32 ) :: i , n , flag , npositive , nnegative real ( real64 ) :: tol , rv real ( real64 ), allocatable , dimension (:,:) :: acpy complex ( real64 ), allocatable , dimension (:) :: vals class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( a , 1 ) tol = 1.0d1 * epsilon ( tol ) ! zero checking tolerance ! Input Checking if ( size ( a , 2 ) /= n ) then call report_nonsquare_matrix_error ( \"determine_local_stability\" , \"a\" , & size ( a , 1 ), size ( a , 2 ), errmgr ) return end if ! Local Memory Allocation allocate ( acpy ( n , n ), source = a , stat = flag ) if ( flag /= 0 ) go to 10 allocate ( vals ( n ), stat = flag ) if ( flag /= 0 ) go to 10 ! Perform the eigen analysis on A call eigen ( acpy , vals , err = errmgr ) if ( errmgr % has_error_occurred ()) return ! Cycle over each eigenvalue hyperbolic = . true . npositive = 0 nnegative = 0 do i = 1 , n rv = real ( vals ( i ), real64 ) if ( abs ( rv ) < tol ) then ! zero-valued real part - must be nonhyperbolic hyperbolic = . false . else if ( rv > 0.0d0 ) then ! positive-valued real part npositive = npositive + 1 else ! negative-valued real part nnegative = nnegative + 1 end if end do ! Characterize the results if ( hyperbolic ) then if ( nnegative == n ) then rst = HYPERBOLIC_FIXED_POINT_SINK else if ( npositive == n ) then rst = HYPERBOLIC_FIXED_POINT_SOURCE else rst = HYPERBOLIC_FIXED_POINT_SADDLE end if else if ( nnegative == 0 . and . npositive == 0 ) then rst = NONHYPERBOLIC_FIXED_POINT_CENTER else if ( nnegative > 0 . and . npositive == 0 ) then rst = NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE else rst = NONHYPERBOLIC_FIXED_POINT_UNSTABLE end if end if ! Optional Outputs if ( present ( ev )) then if ( size ( ev ) /= n ) then call report_array_size_error ( \"determine_local_stability\" , \"ev\" , & n , size ( ev ), errmgr ) return end if ev = vals end if ! End return ! Memory Error Handling 10 continue call report_memory_error ( \"determine_local_stability\" , flag , errmgr ) return end function ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_stability.f90.html"},{"title":"dynamics_structural.f90 – DYNAMICS","text":"Contents Modules dynamics_structural Source Code dynamics_structural.f90 Source Code ! Shape Functions: ! 2D Line: https://www.mm.bme.hu/~gyebro/files/ans_help_v182/ans_thry/thy_shp1.html#shp2dlinerdof ! 3D Line: https://www.mm.bme.hu/~gyebro/files/ans_help_v182/ans_thry/thy_shp2.html#shp3d2node module dynamics_structural use iso_fortran_env use linalg , only : csr_matrix , create_csr_matrix , sort use ferror use dynamics_error_handling use dynamics_rotation implicit none private public :: DYN_ONE_POINT_INTEGRATION_RULE public :: DYN_TWO_POINT_INTEGRATION_RULE public :: DYN_THREE_POINT_INTEGRATION_RULE public :: DYN_FOUR_POINT_INTEGRATION_RULE public :: node public :: material public :: element public :: line_element public :: beam_element_2d public :: shape_function_derivative public :: shape_function_second_derivative public :: create_connectivity_matrix public :: apply_boundary_conditions public :: apply_displacement_constraint public :: restore_constrained_values public :: point public :: beam_element_3d ! ****************************************************************************** ! CONSTANTS ! ------------------------------------------------------------------------------ integer ( int32 ), parameter :: DYN_ONE_POINT_INTEGRATION_RULE = 1 !! Defines a single-point integration rule. integer ( int32 ), parameter :: DYN_TWO_POINT_INTEGRATION_RULE = 2 !! Defines a two-point integration rule. integer ( int32 ), parameter :: DYN_THREE_POINT_INTEGRATION_RULE = 3 !! Defines a three-point integration rule. integer ( int32 ), parameter :: DYN_FOUR_POINT_INTEGRATION_RULE = 4 !! Defines a four-point integration rule. ! ****************************************************************************** ! TYPES ! ------------------------------------------------------------------------------ type :: point !! Defines a point in 3D, Cartesian space. real ( real64 ) :: x !! The x-coordinate. real ( real64 ) :: y !! The y-coordinate. real ( real64 ) :: z !! The z-coordinate. end type ! ------------------------------------------------------------------------------ type , extends ( point ) :: node !! Defines a node. integer ( int32 ) :: index !! The global index of the node. integer ( int32 ) :: dof !! The number of degrees of freeedom associated with this node. end type ! ------------------------------------------------------------------------------ type :: material !! Defines a linear-elastic-isotropic material. real ( real64 ) :: density !! The density of the material. real ( real64 ) :: modulus !! The modulus of elasticity of the material. real ( real64 ) :: poissons_ratio !! The Poisson's ratio of the material. end type ! ------------------------------------------------------------------------------ type , abstract :: element !! Defines an element. type ( material ) :: material !! The material. contains procedure ( element_query ), deferred , public , pass :: get_dimensionality procedure ( element_query ), deferred , public , pass :: get_node_count procedure ( element_get_node ), deferred , public , pass :: get_node procedure ( element_query ), deferred , public , pass :: get_dof_per_node procedure ( element_shape_function ), deferred , public , pass :: & evaluate_shape_function procedure ( element_matrix_function ), deferred , public , pass :: & shape_function_matrix procedure ( element_matrix_function ), deferred , public , pass :: & strain_displacement_matrix procedure ( element_const_matrix_function ), deferred , public , & pass :: constitutive_matrix procedure ( element_matrix_function ), deferred , public , pass :: & jacobian procedure , public :: stiffness_matrix => e_stiffness_matrix procedure , public :: mass_matrix => e_mass_matrix procedure , public :: external_force_vector => e_ext_force_vector end type ! ------------------------------------------------------------------------------ type , extends ( element ), abstract :: line_element !! Defines a line element type. real ( real64 ) :: area !! The element cross-sectional area. contains procedure ( line_element_get_terminal ), deferred , public , pass :: & get_terminal_nodes procedure ( line_element_const_matrix_function ), deferred , public , & pass :: rotation_matrix procedure , public :: length => le_length procedure , public :: stiffness_matrix => le_stiffness_matrix procedure , public :: mass_matrix => le_mass_matrix procedure , public :: external_force_vector => le_ext_force_vector end type ! ------------------------------------------------------------------------------ type , extends ( line_element ) :: beam_element_2d !! Defines a two-dimensional Bernoulli-Euler beam element. real ( real64 ) :: moment_of_inertia !! The beam moment of inertia (second moment of area). type ( node ) :: node_1 !! The first node of the element (s = -1). type ( node ) :: node_2 !! The second node of the element (s = 1). contains procedure , public :: get_dimensionality => b2d_dimensionality procedure , public :: get_node_count => b2d_get_node_count procedure , public :: get_dof_per_node => b2d_dof_per_node procedure , public :: get_node => b2d_get_node procedure , public :: get_terminal_nodes => b2d_terminal_nodes procedure , public :: evaluate_shape_function => b2d_shape_function procedure , public :: shape_function_matrix => b2d_shape_function_matrix_2d procedure , public :: strain_displacement_matrix => b2d_strain_disp_matrix_2d procedure , public :: constitutive_matrix => b2d_constitutive_matrix procedure , public :: jacobian => b2d_jacobian procedure , public :: rotation_matrix => b2d_rotation_matrix procedure , public :: stiffness_matrix => b2d_stiffness_matrix procedure , public :: mass_matrix => b2d_mass_matrix end type ! ------------------------------------------------------------------------------ type , extends ( line_element ) :: beam_element_3d !! Defines a three-dimensional Bernoulli-Euler beam element. real ( real64 ) :: Ixx !! The beam moment of inertia about the element x-axis. real ( real64 ) :: Iyy !! The beam moment of inertia about the element y-axis. real ( real64 ) :: Izz !! The beam moment of inertia about the element z-axis. type ( node ) :: node_1 !! The first node of the element (s = -1). type ( node ) :: node_2 !! The second node of the element (s = 1). type ( point ) :: orientation_point !! A point used to determine the orientation of the beam in 3D !! space. The orientation point is measured relative to the first !! node in the element. Specifically, the element z axis is assumed !! to be defined by the location of this point relative to the !! location of node 1. contains procedure , public :: get_dimensionality => b3d_dimensionality procedure , public :: get_node_count => b3d_get_node_count procedure , public :: get_dof_per_node => b3d_dof_per_node procedure , public :: get_node => b3d_get_node procedure , public :: get_terminal_nodes => b3d_terminal_nodes procedure , public :: evaluate_shape_function => b3d_shape_function procedure , public :: shape_function_matrix => b3d_shape_function_matrix_3d procedure , public :: strain_displacement_matrix => b3d_strain_disp_matrix_3d procedure , public :: constitutive_matrix => b3d_constitutive_matrix procedure , public :: jacobian => b3d_jacobian procedure , public :: rotation_matrix => b3d_rotation_matrix procedure , public :: stiffness_matrix => b3d_stiffness_matrix procedure , public :: mass_matrix => b3d_mass_matrix end type ! ****************************************************************************** ! INTERFACES ! ------------------------------------------------------------------------------ interface pure function element_query ( this ) result ( rst ) !! Defines the signature of a function performing a query on an !! integer-valued property of a element type. use iso_fortran_env , only : int32 import element class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ) :: rst !! The resulting value. end function pure function element_get_node ( this , i ) result ( rst ) !! Defines the signature of a function for retrieving the requested !! node from the element. use iso_fortran_env , only : int32 import node import element class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ) :: i !! The local index of the node to retrieve. type ( node ) :: rst !! The node. end function pure function element_matrix_function ( this , s ) result ( rst ) !! Defines the signature of a routine for returning a matrix !! associated with the element. use iso_fortran_env , only : real64 import element class ( element ), intent ( in ) :: this !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinates at which the matrix !! should be evaluated. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. end function pure function element_const_matrix_function ( this ) result ( rst ) !! Defines the signature of a routine for returning a matrix !! associated with the element. use iso_fortran_env , only : real64 import element class ( element ), intent ( in ) :: this !! The element object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. end function pure function element_shape_function ( this , i , s ) result ( rst ) !! Defines the signature of a routine for computing the value of !! the i-th element shape function at natural coordinate. use iso_fortran_env , only : int32 , real64 import element class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ) :: i !! The index of the shape function to evaluate. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinates at which to evaluate !! the shape function. real ( real64 ) :: rst !! The value of the i-th shape function at s. end function pure subroutine line_element_get_terminal ( this , i1 , i2 ) !! Defines the signature of a routine for returning the terminal !! node numbers. use iso_fortran_env , only : int32 import line_element class ( line_element ), intent ( in ) :: this !! The line_element object. integer ( int32 ), intent ( out ) :: i1 !! The index of the node at the head of the element. integer ( int32 ), intent ( out ) :: i2 !! The index of the node at the tail of the element. end subroutine pure function line_element_const_matrix_function ( this ) result ( rst ) !! Defines the signature of a routine for returning a matrix !! associated with the line_element. use iso_fortran_env , only : real64 import line_element class ( line_element ), intent ( in ) :: this !! The line_element object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. end function pure function integrand ( elem , s ) result ( rst ) !! Defines the signature of a function containing an integrand. use iso_fortran_env , only : real64 import element class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The result. end function end interface ! ****************************************************************************** ! OVERLOADED ROUTINES ! ------------------------------------------------------------------------------ interface apply_boundary_conditions module procedure :: apply_boundary_conditions_mtx module procedure :: apply_boundary_conditions_vec end interface contains ! ****************************************************************************** ! DIFFERENTIATION ROUTINES ! ------------------------------------------------------------------------------ pure function shape_function_derivative ( index , elem , s , i ) result ( rst ) !! Computes the derivative of the shape function with respect to the natural !! coordinate specified. integer ( int32 ), intent ( in ) :: index !! The index of the shape function to evaluate. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate at which to evaluate the derivative. integer ( int32 ), intent ( in ) :: i !! The index of the natural coordinate to with which the derivative is !! to be computed. real ( real64 ) :: rst !! The result. ! Local Variables real ( real64 ) :: na , nb , h ( size ( s )) ! Initialization h = 0.0d0 h ( i ) = sqrt ( epsilon ( na )) ! Process na = elem % evaluate_shape_function ( index , s + h ) nb = elem % evaluate_shape_function ( index , s - h ) rst = ( na - nb ) / ( 2.0d0 * h ( i )) end function ! ------------------------------------------------------------------------------ pure function shape_function_second_derivative ( index , elem , s , i ) result ( rst ) !! Computes the second derivative of the shape function with respect to the !! natural coordinate specified. integer ( int32 ), intent ( in ) :: index !! The index of the shape function to evaluate. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate at which to evaluate the derivative. integer ( int32 ), intent ( in ) :: i !! The index of the natural coordinate to with which the derivative is !! to be computed. real ( real64 ) :: rst !! The result. ! Local Variables real ( real64 ) :: na , nb , nc , h ( size ( s )) ! Initialization h = 0.0d0 h ( i ) = ( epsilon ( na )) ** 0.25d0 na = elem % evaluate_shape_function ( index , s + h ) nb = elem % evaluate_shape_function ( index , s ) nc = elem % evaluate_shape_function ( index , s - h ) rst = ( na - 2.0d0 * nb + nc ) / ( h ( i ) ** 2 ) end function ! ****************************************************************************** ! INTEGRATION ! ------------------------------------------------------------------------------ pure function get_model_parameters ( rule ) result ( rst ) !! Gets the requested integration model parameters. integer ( int32 ), intent ( in ) :: rule !! The integration rule. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integration parameters. ! Local Variables real ( real64 ) :: x , w1 , w2 , pt1 , pt2 ! Process select case ( rule ) case ( DYN_ONE_POINT_INTEGRATION_RULE ) allocate ( rst ( 2 , 2 )) rst = reshape ([ 0.0d0 , 0.0d0 , 2.0d0 , 2.0d0 ], [ 2 , 2 ]) case ( DYN_TWO_POINT_INTEGRATION_RULE ) allocate ( rst ( 2 , 2 )) x = sqrt ( 3.0d0 ) / 3.0d0 rst = reshape ([ - x , x , 1.0d0 , 1.0d0 ], [ 2 , 2 ]) case ( DYN_THREE_POINT_INTEGRATION_RULE ) allocate ( rst ( 3 , 2 )) x = sqrt ( 3.0d0 / 5.0d0 ) rst = reshape ([ 0.0d0 , - x , x , w1 , w2 , w2 ], [ 3 , 2 ]) case default ! Four Point Rule allocate ( rst ( 4 , 2 )) pt1 = sqrt (( 3.0d0 / 7.0d0 ) - ( 2.0d0 / 7.0d0 ) * sqrt ( 6.0d0 / 5.0d0 )) pt1 = sqrt (( 3.0d0 / 7.0d0 ) + ( 2.0d0 / 7.0d0 ) * sqrt ( 6.0d0 / 5.0d0 )) w1 = ( 1.8d1 + sqrt ( 3.0d1 )) / 3.6d1 w2 = ( 1.8d1 - sqrt ( 3.0d1 )) / 3.6d1 rst = reshape ([ - pt1 , pt1 , - pt2 , pt2 , w1 , w1 , w2 , w2 ], [ 4 , 2 ]) end select end function ! ------------------------------------------------------------------------------ pure function integrate_1d ( fcn , elem , rule ) result ( rst ) !! Computes the integral of the specified integrand given an element and an !! integration rule. procedure ( integrand ) :: fcn !! The integrand. class ( element ), intent ( in ) :: elem !! The element object. integer ( int32 ), intent ( in ) :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE real ( real64 ), allocatable , dimension (:,:) :: rst !! The result of the integration. ! Local Variables integer ( int32 ) :: i real ( real64 ), allocatable , dimension (:,:) :: s ! Process s = get_model_parameters ( rule ) rst = s ( 1 , 2 ) * fcn ( elem , [ s ( 1 , 1 )]) do i = 2 , size ( s , 1 ) rst = rst + s ( i , 2 ) * fcn ( elem , [ s ( i , 1 )]) end do end function ! ------------------------------------------------------------------------------ pure function integrate ( fcn , elem , rule ) result ( rst ) !! Computes the integral of the specified integrand given an element and an !! integration rule. procedure ( integrand ) :: fcn !! The integrand. class ( element ), intent ( in ) :: elem !! The element object. integer ( int32 ), intent ( in ) :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE real ( real64 ), allocatable , dimension (:,:) :: rst !! The result of the integration. ! Process select type ( elem ) class is ( line_element ) rst = integrate_1d ( fcn , elem , rule ) end select end function ! ****************************************************************************** ! ASSEMBLY ROUTINES ! ------------------------------------------------------------------------------ pure function find_global_dof ( n , nodes ) result ( rst ) !! Finds the index of the global DOF node in a list of nodes. class ( node ), intent ( in ) :: n !! The node for which to search. class ( node ), intent ( in ), dimension (:) :: nodes !! The list of nodes integer ( int32 ) :: rst !! The requested index. ! Local Variables integer ( int32 ) :: i ! Process rst = 0 do i = 1 , size ( nodes ) if ( n % index == nodes ( i )% index ) then rst = rst + 1 exit end if rst = rst + nodes ( i )% dof end do end function ! ------------------------------------------------------------------------------ function create_connectivity_matrix ( gdof , e , nodes , err ) result ( rst ) !! Creates a connectivity matrix for the element. integer ( int32 ), intent ( in ) :: gdof !! The number of global degrees of freedom. class ( element ), intent ( in ) :: e !! The element. class ( node ), intent ( in ), dimension (:) :: nodes !! The global node list. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables integer ( int32 ) :: i , j , col , nnodes , nnz , row , flag class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if nnodes = e % get_node_count () nnz = e % get_dof_per_node () * nnodes allocate ( rst ( nnz , gdof ), source = 0.0d0 , stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"create_connectivity_matrix\" , flag , errmgr ) return end if ! Process row = 0 do j = 1 , nnodes col = find_global_dof ( e % get_node ( j ), nodes ) do i = 1 , e % get_dof_per_node () row = row + 1 rst ( row , col ) = 1.0d0 col = col + 1 end do end do end function ! ------------------------------------------------------------------------------ function apply_boundary_conditions_mtx ( gdof , x , err ) result ( rst ) !! Applies boundary conditions to a matrix by removal of the appropriate !! rows and columns. integer ( int32 ), intent ( inout ), dimension (:) :: gdof !! An array of the global degrees of freedom to restrain. The array !! is sorted into ascending order on output. real ( real64 ), intent ( in ), dimension (:,:) :: x !! The matrix to constrain. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The altered matrix. ! Local Variables integer ( int32 ) :: i , j , ii , m , n , nbc , mnew , flag integer ( int32 ), allocatable , dimension (:) :: indices class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if m = size ( x , 1 ) n = size ( x , 2 ) nbc = size ( gdof ) mnew = m - nbc ! Input Checking if ( m /= n ) then call report_nonsquare_matrix_error ( \"apply_boundary_conditions_mtx\" , & \"x\" , m , n , errmgr ) return end if if ( mnew < 1 ) then call report_overconstraint_error ( \"apply_boundary_conditions_mtx\" , & errmgr ) return end if do i = 1 , nbc if ( gdof ( i ) < 1 . or . gdof ( i ) > m ) then call report_array_index_out_of_bounds_error ( & \"apply_boundary_conditions_mtx\" , \"gdof\" , gdof ( i ), m , errmgr ) return end if end do ! Memory Allocation allocate ( rst ( mnew , mnew ), stat = flag ) if ( flag == 0 ) allocate ( indices ( m - nbc ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"apply_boundary_conditions_mtx\" , flag , errmgr ) return end if ! Sort gdof into ascending order call sort ( gdof , . true .) ! Check for duplicate values in GDOF do i = 2 , nbc if ( gdof ( i ) == gdof ( i - 1 )) then call report_nonmonotonic_array_error (& \"apply_boundary_conditions_mtx\" , \"gdof\" , i , errmgr ) return end if end do ! Process ii = 1 j = 0 do i = 1 , m if ( gdof ( ii ) /= i ) then j = j + 1 indices ( j ) = i else ii = ii + 1 if ( ii > nbc ) ii = nbc end if end do ! Now, we only need store the rows and columns stored in indices rst = x ( indices , indices ) end function ! ------------------------------------------------------------------------------ function apply_boundary_conditions_vec ( gdof , x , err ) result ( rst ) !! Applies boundary conditions to a vector by removal of the appropriate !! items. integer ( int32 ), intent ( inout ), dimension (:) :: gdof !! An array of the global degrees of freedom to restrain. The array !! is sorted into ascending order on output. real ( real64 ), intent ( in ), dimension (:) :: x !! The vector to constrain. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:) :: rst !! The altered vector. ! Local Variables integer ( int32 ) :: i , j , ii , n , nbc , nnew , flag integer ( int32 ), allocatable , dimension (:) :: indices class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( x ) nbc = size ( gdof ) nnew = n - nbc ! Input Checking if ( nnew < 1 ) then call report_overconstraint_error ( \"apply_boundary_conditions_vec\" , & errmgr ) return end if do i = 1 , nbc if ( gdof ( i ) < 1 . or . gdof ( i ) > n ) then call report_array_index_out_of_bounds_error ( & \"apply_boundary_conditions_vec\" , \"gdof\" , gdof ( i ), n , errmgr ) return end if end do ! Memory Allocation allocate ( rst ( nnew ), stat = flag ) if ( flag == 0 ) allocate ( indices ( n - nbc ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"apply_boundary_conditions_vec\" , flag , errmgr ) return end if ! Sort gdof into ascending order call sort ( gdof , . true .) ! Check for duplicate values in GDOF do i = 2 , nbc if ( gdof ( i ) == gdof ( i - 1 )) then call report_nonmonotonic_array_error ( & \"apply_boundary_conditions_vec\" , \"gdof\" , i , errmgr ) return end if end do ! Process ii = 1 j = 0 do i = 1 , n if ( gdof ( ii ) /= i ) then j = j + 1 indices ( j ) = i else ii = ii + 1 if ( ii > nbc ) ii = nbc end if end do ! Now, just store the appropriate items in the output vector rst = x ( indices ) end function ! ------------------------------------------------------------------------------ function restore_constrained_values ( gdof , x , err ) result ( rst ) !! Restores the constrained degrees-of-freedom from the boundary conditions !! applied by apply_boundary_conditions. integer ( int32 ), intent ( inout ), dimension (:) :: gdof !! An array of the global degrees of freedom to restrain. The array !! is sorted into ascending order on output. real ( real64 ), intent ( in ), dimension (:) :: x !! The constrained vector. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:) :: rst !! The altered vector. ! Local Variables integer ( int32 ) :: i , j , ii , n , nbc , nnew , flag class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( x ) nbc = size ( gdof ) nnew = n + nbc ! Input Checking do i = 1 , nbc if ( gdof ( i ) < 1 . or . gdof ( i ) > nnew ) then call report_array_index_out_of_bounds_error ( & \"restore_constrained_values\" , \"gdof\" , gdof ( i ), nnew , errmgr ) return end if end do ! Memory Allocation allocate ( rst ( nnew ), source = 0.0d0 , stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"restore_constrained_values\" , flag , errmgr ) return end if ! Sort gdof into ascending order call sort ( gdof , . true .) ! Check for duplicate values in GDOF do i = 2 , nbc if ( gdof ( i ) == gdof ( i - 1 )) then call report_nonmonotonic_array_error ( & \"restore_constrained_values\" , \"gdof\" , i , errmgr ) return end if end do ! Process ii = 1 j = 0 do i = 1 , nnew if ( i == gdof ( ii )) then ii = ii + 1 if ( ii > nbc ) ii = nbc else j = j + 1 rst ( i ) = x ( j ) end if end do end function ! ------------------------------------------------------------------------------ ! REF: https://www.sciencedirect.com/topics/engineering/prescribed-displacement-boundary-condition subroutine apply_displacement_constraint ( dof , val , k , f ) !! Applies a displacement constraint to the specified degree of freedom. integer ( int32 ), intent ( in ) :: dof !! The global degree-of-freedom to which the constraint should be !! applied. real ( real64 ), intent ( in ) :: val !! The value of the displacement constraint. real ( real64 ), intent ( inout ), dimension (:,:) :: k !! The stiffness matrix to which the constraint should be applied. real ( real64 ), intent ( inout ), dimension (:) :: f !! The external force vector to which the constraint should be applied. ! Wipe out the rows in the matrix and place a value of 1 on the diagonal k ( dof ,:) = 0.0d0 k ( dof , dof ) = 1.0d0 ! Update the external force vector f ( dof ) = val end subroutine ! ****************************************************************************** ! ELEMENT MEMBERS ! ------------------------------------------------------------------------------ pure function e_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables integer ( int32 ) :: r ! Initialization if ( present ( rule )) then r = rule else r = DYN_TWO_POINT_INTEGRATION_RULE end if ! Process rst = integrate ( element_stiffness_integrand , this , r ) end function ! ---------- pure function element_stiffness_integrand ( elem , s ) result ( rst ) !! The integrand function for computing the stiffness matrix of an element. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate vector at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integrand. ! Local Variables real ( real64 ) :: jdet real ( real64 ), allocatable , dimension (:,:) :: b , bt , d , x , jac ! Process b = elem % strain_displacement_matrix ( s ) bt = transpose ( b ) d = elem % constitutive_matrix () jac = elem % jacobian ( s ) jdet = det ( jac ) x = matmul ( d , b ) rst = jdet * matmul ( bt , x ) end function ! ------------------------------------------------------------------------------ pure function e_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables integer ( int32 ) :: r ! Initialization if ( present ( rule )) then r = rule else r = DYN_TWO_POINT_INTEGRATION_RULE end if ! Process rst = integrate ( element_mass_integrand , this , r ) end function ! ---------- pure function element_mass_integrand ( elem , s ) result ( rst ) !! The integrand function for computing the mass matrix of an element. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate vector at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integrand. ! Local Variables real ( real64 ) :: jdet real ( real64 ), allocatable , dimension (:,:) :: N , Nt , jac ! Process N = elem % shape_function_matrix ( s ) Nt = transpose ( N ) jac = elem % jacobian ( s ) jdet = det ( jac ) rst = elem % material % density * jdet * matmul ( Nt , N ) end function ! ------------------------------------------------------------------------------ pure function e_ext_force_vector ( this , q , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( element ), intent ( in ) :: this !! The element object. real ( real64 ), intent ( in ), dimension (:) :: q !! The surface traction forces vector or body force vector. !! For instance, a 2D problem this vector would look like [qx, qy]**T. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:) :: rst !! The resulting vector. ! Local Variables integer ( int32 ) :: r ! Initialization if ( present ( rule )) then r = rule else r = DYN_TWO_POINT_INTEGRATION_RULE end if ! Process rst = matmul ( & integrate ( element_ext_force_integrand , this , r ), & q & ) end function ! ---------- pure function element_ext_force_integrand ( elem , s ) result ( rst ) !! The integrand function for computing the external force vector of an !! element. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate vector at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integrand. ! Local Variables real ( real64 ) :: jdet real ( real64 ), allocatable , dimension (:,:) :: Nt , jac ! Process Nt = transpose ( elem % shape_function_matrix ( s )) jac = elem % jacobian ( s ) jdet = det ( jac ) rst = jdet * Nt end function ! ****************************************************************************** ! LINE_ELEMENT MEMBERS ! ------------------------------------------------------------------------------ pure function le_length ( this ) result ( rst ) !! Computes the length of the line_element. class ( line_element ), intent ( in ) :: this !! The line_element object. real ( real64 ) :: rst !! The length of the line element. ! Local Variables real ( real64 ) :: dx , dy , dz integer ( int32 ) :: i1 , i2 type ( node ) :: n1 , n2 ! Process call this % get_terminal_nodes ( i1 , i2 ) n1 = this % get_node ( i1 ) n2 = this % get_node ( i2 ) dx = n2 % x - n1 % x dy = n2 % y - n1 % y dz = n2 % z - n1 % z rst = sqrt ( dx ** 2 + dy ** 2 + dz ** 2 ) end function ! ------------------------------------------------------------------------------ pure function le_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( line_element ), intent ( in ) :: this !! The line_element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Compute the stiffness matrix and apply the rotation transformation rst = e_stiffness_matrix ( this , rule ) rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function le_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( line_element ), intent ( in ) :: this !! The line_element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Compute the mass matrix and apply the rotation transformation rst = e_mass_matrix ( this , rule ) rst = this % area * matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function le_ext_force_vector ( this , q , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( line_element ), intent ( in ) :: this !! The line_element object. real ( real64 ), intent ( in ), dimension (:) :: q !! The surface traction forces vector or body force vector. !! For instance, a 2D problem this vector would look like [qx, qy]**T. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:) :: rst !! The resulting vector. ! Local Variables real ( real64 ), allocatable , dimension (:,:) :: T ! Compute the rotation matrix T = this % rotation_matrix () ! Compute the force vector rst = e_ext_force_vector ( this , q , rule ) rst = matmul ( T , rst ) end function ! ****************************************************************************** ! BEAM_2D ROUTINES ! ------------------------------------------------------------------------------ pure function b2d_dimensionality ( this ) result ( rst ) !! Gets the dimensionality of the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ) :: rst !! The dimensionality. rst = 2 end function ! ------------------------------------------------------------------------------ pure function b2d_get_node_count ( this ) result ( rst ) !! Gets the number of nodes for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ) :: rst !! The number of nodes. rst = 2 end function ! ------------------------------------------------------------------------------ pure function b2d_dof_per_node ( this ) result ( rst ) !! Gets the number of degrees of freedom per node. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ) :: rst !! The number of DOF per node. rst = 3 end function ! ------------------------------------------------------------------------------ pure function b2d_get_node ( this , i ) result ( rst ) !! Gets the requested node from the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ) :: i !! The local index of the node to retrieve. type ( node ) :: rst !! The requested node. if ( i == 1 ) then rst = this % node_1 else rst = this % node_2 end if end function ! ------------------------------------------------------------------------------ pure subroutine b2d_terminal_nodes ( this , i1 , i2 ) !! Gets the terminal node numbers for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( out ) :: i1 !! The index of the node at the head of the element. integer ( int32 ), intent ( out ) :: i2 !! The index of the node at the tail of the element. i1 = 1 i2 = 2 end subroutine ! ------------------------------------------------------------------------------ pure function b2d_shape_function ( this , i , s ) result ( rst ) !! Evaluates the i-th shape function at natural coordinate s. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ) :: i !! The index of the shape function to evaluate. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate !! the shape function. real ( real64 ) :: rst !! The value of the i-th shape function at s. ! Local Variables real ( real64 ) :: l ! Process select case ( i ) case ( 1 ) rst = 0.5d0 * ( 1.0d0 - s ( 1 )) case ( 2 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 2.0d0 + s ( 1 )) case ( 3 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 1.0d0 + s ( 1 )) case ( 4 ) rst = 0.5d0 * ( 1.0d0 + s ( 1 )) case ( 5 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( 2.0d0 - s ( 1 )) case ( 6 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( s ( 1 ) - 1.0d0 ) case default rst = 0.0d0 end select end function ! ------------------------------------------------------------------------------ pure function b2d_shape_function_matrix_2d ( this , s ) result ( rst ) !! Computes the shape function matrix for a beam element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the shape !! functions. real ( real64 ), allocatable , dimension (:,:) :: rst !! The shape function matrix. ! Local Variables real ( real64 ) :: n1 , n2 , n3 , n4 , n5 , n6 , l ! Initialization allocate ( rst ( 2 , 6 ), source = 0.0d0 ) l = this % length () ! Process n1 = this % evaluate_shape_function ( 1 , s ) n2 = this % evaluate_shape_function ( 2 , s ) n3 = 0.5d0 * l * this % evaluate_shape_function ( 3 , s ) n4 = this % evaluate_shape_function ( 4 , s ) n5 = this % evaluate_shape_function ( 5 , s ) n6 = 0.5d0 * l * this % evaluate_shape_function ( 6 , s ) rst ( 1 , 1 ) = n1 rst ( 2 , 2 ) = n2 rst ( 2 , 3 ) = n3 rst ( 1 , 4 ) = n4 rst ( 2 , 5 ) = n5 rst ( 2 , 6 ) = n6 end function ! ------------------------------------------------------------------------------ pure function b2d_strain_disp_matrix_2d ( this , s ) result ( rst ) !! Computes the strain-displacement matrix for a 2D beam element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The strain-displacement matrix. ! Local Variables real ( real64 ) :: l , dsdx , dn1ds , dn2ds , dn3ds , dn4ds , dn5ds , dn6ds ! Initialization allocate ( rst ( 2 , 6 ), source = 0.0d0 ) ! Process l = this % length () dsdx = 2.0d0 / l ! s = 2 * x / L - 1, so ds/dx = 2 / L dn1ds = shape_function_derivative ( 1 , this , s , 1 ) dn2ds = shape_function_second_derivative ( 2 , this , s , 1 ) dn3ds = shape_function_second_derivative ( 3 , this , s , 1 ) dn4ds = shape_function_derivative ( 4 , this , s , 1 ) dn5ds = shape_function_second_derivative ( 5 , this , s , 1 ) dn6ds = shape_function_second_derivative ( 6 , this , s , 1 ) rst ( 1 , 1 ) = dn1ds * dsdx rst ( 2 , 2 ) = dn2ds * dsdx ** 2 rst ( 2 , 3 ) = 0.5d0 * l * dn3ds * dsdx ** 2 rst ( 1 , 4 ) = dn4ds * dsdx rst ( 2 , 5 ) = dn5ds * dsdx ** 2 rst ( 2 , 6 ) = 0.5d0 * l * dn6ds * dsdx ** 2 end function ! ------------------------------------------------------------------------------ pure function b2d_constitutive_matrix ( this ) result ( rst ) !! Computes the constitutive matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Process allocate ( rst ( 2 , 2 ), source = 0.0d0 ) rst ( 1 , 1 ) = this % area * this % material % modulus rst ( 2 , 2 ) = this % moment_of_inertia * this % material % modulus end function ! ------------------------------------------------------------------------------ pure function b2d_jacobian ( this , s ) result ( rst ) !! Computes the Jacobian matrix for a 2D beam element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The Jacobian matrix. rst = reshape ([ 0.5d0 * this % length ()], [ 1 , 1 ]) end function ! ------------------------------------------------------------------------------ pure function b2d_rotation_matrix ( this ) result ( rst ) !! Computes the rotation matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 6-by-6 rotation matrix. ! Local Variables real ( real64 ) :: theta , ct , st type ( node ) :: n1 , n2 ! Process allocate ( rst ( 6 , 6 ), source = 0.0d0 ) n1 = this % get_node ( 1 ) n2 = this % get_node ( 2 ) theta = atan2 ( n2 % y - n1 % y , n2 % x - n1 % x ) ct = cos ( theta ) st = sin ( theta ) rst ( 1 , 1 ) = ct rst ( 2 , 1 ) = st rst ( 1 , 2 ) = - st rst ( 2 , 2 ) = ct rst ( 3 , 3 ) = 1.0d0 rst ( 4 , 4 ) = ct rst ( 5 , 4 ) = st rst ( 4 , 5 ) = - st rst ( 5 , 5 ) = ct rst ( 6 , 6 ) = 1.0d0 end function ! ------------------------------------------------------------------------------ pure function b2d_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: A , E , I , L real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization A = this % area E = this % material % modulus I = this % moment_of_inertia L = this % length () ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Construct the stiffness matrix allocate ( rst ( 6 , 6 ), source = 0.0d0 ) rst ( 1 , 1 ) = A * E / L rst ( 2 , 2 ) = 1 2.0d0 * E * I / ( L ** 3 ) rst ( 3 , 3 ) = 4.0d0 * E * I / L rst ( 2 , 3 ) = 6.0d0 * E * I / ( L ** 2 ) rst ( 3 , 2 ) = rst ( 2 , 3 ) rst ( 1 , 4 ) = - rst ( 1 , 1 ) rst ( 4 , 1 ) = rst ( 1 , 4 ) rst ( 2 , 5 ) = - rst ( 2 , 2 ) rst ( 5 , 2 ) = rst ( 2 , 5 ) rst ( 2 , 6 ) = rst ( 2 , 3 ) rst ( 6 , 2 ) = rst ( 2 , 6 ) rst ( 3 , 5 ) = - rst ( 2 , 3 ) rst ( 5 , 3 ) = rst ( 3 , 5 ) rst ( 3 , 6 ) = 2.0d0 * E * I / L rst ( 6 , 3 ) = rst ( 3 , 6 ) rst ( 4 : 6 , 4 : 6 ) = rst ( 1 : 3 , 1 : 3 ) rst ( 5 , 6 ) = - rst ( 2 , 3 ) rst ( 6 , 5 ) = rst ( 5 , 6 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function b2d_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: rho , A , L , f real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization rho = this % material % density A = this % area L = this % length () f = rho * A * L / 4.2d2 ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Construct the mass matrix allocate ( rst ( 6 , 6 ), source = 0.0d0 ) rst ( 1 , 1 ) = 1.4d2 * f rst ( 4 , 1 ) = 7.0d1 * f rst ( 2 , 2 ) = 1.56d2 * f rst ( 3 , 2 ) = 2.2d1 * L * f rst ( 5 , 2 ) = 5.4d1 * f rst ( 6 , 2 ) = - 1.3d1 * L * f rst ( 2 , 3 ) = rst ( 3 , 2 ) rst ( 3 , 3 ) = 4.0d0 * L ** 2 * f rst ( 5 , 3 ) = 1.3d1 * L * f rst ( 6 , 3 ) = - 3.0d0 * L ** 2 * f rst ( 1 , 4 ) = rst ( 4 , 1 ) rst ( 4 , 4 ) = rst ( 1 , 1 ) rst ( 2 , 5 ) = rst ( 5 , 2 ) rst ( 3 , 5 ) = rst ( 5 , 3 ) rst ( 5 , 5 ) = rst ( 2 , 2 ) rst ( 6 , 5 ) = - 2.2d1 * L * f rst ( 2 , 6 ) = rst ( 6 , 2 ) rst ( 3 , 6 ) = rst ( 6 , 3 ) rst ( 5 , 6 ) = rst ( 6 , 5 ) rst ( 6 , 6 ) = rst ( 3 , 3 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ****************************************************************************** ! PRIVATE ROUTINES ! ------------------------------------------------------------------------------ pure function det_1 ( x ) result ( rst ) ! Determinant of a 1-by-1 matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x real ( real64 ) :: rst rst = x ( 1 , 1 ) end function ! ------------------------------------------------------------------------------ pure function det_2 ( x ) result ( rst ) ! Determinant of a 2-by-2 matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x real ( real64 ) :: rst rst = x ( 1 , 1 ) * x ( 2 , 2 ) - x ( 1 , 2 ) * x ( 2 , 1 ) end function ! ------------------------------------------------------------------------------ pure function det_3 ( x ) result ( rst ) ! Determinant of a 3-by-3 matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x real ( real64 ) :: rst rst = x ( 1 , 1 ) * ( x ( 2 , 2 ) * x ( 3 , 3 ) - x ( 2 , 3 ) * x ( 3 , 2 )) - & x ( 1 , 2 ) * ( x ( 2 , 1 ) * x ( 3 , 3 ) - x ( 2 , 3 ) * x ( 3 , 1 )) + & x ( 1 , 3 ) * ( x ( 2 , 1 ) * x ( 3 , 2 ) - x ( 2 , 2 ) * x ( 3 , 1 )) end function ! ------------------------------------------------------------------------------ pure function det ( x ) result ( rst ) !! Computes the determinant of a matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x !! The matrix on which to operate. real ( real64 ) :: rst !! The determinant. select case ( size ( x , 1 )) case ( 1 ) rst = det_1 ( x ) case ( 2 ) rst = det_2 ( x ) case ( 3 ) rst = det_3 ( x ) case default rst = 0.0d0 end select end function ! ------------------------------------------------------------------------------ ! REF: https://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line pure function normal_vector_to_line ( pt1 , pt2 , pt ) result ( rst ) !! Computes the normal vector to a line defined by pt1 and pt2 assuming !! some point (pt) not on the line. class ( point ), intent ( in ) :: pt1 !! The origin point of the line segment. class ( point ), intent ( in ) :: pt2 !! The termination point of the line segment. class ( point ), intent ( in ) :: pt !! A point, not on the line. real ( real64 ) :: rst ( 3 ) !! The resulting normal vector (unit length). ! Local Variables real ( real64 ) :: a ( 3 ), p ( 3 ), n ( 3 ), amp ( 3 ) ! Initialization a = [ pt1 % x , pt1 % y , pt1 % z ] n = [ pt2 % x , pt2 % y , pt2 % z ] - a p = [ pt % x , pt % y , pt % z ] amp = a - p rst = amp - dot_product ( amp , n ) * n rst = rst / norm2 ( rst ) end function ! ****************************************************************************** ! BEAM_3D ROUTINES ! ------------------------------------------------------------------------------ pure function b3d_dimensionality ( this ) result ( rst ) !! Gets the dimensionality of the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ) :: rst !! The dimensionality. rst = 3 end function ! ------------------------------------------------------------------------------ pure function b3d_get_node_count ( this ) result ( rst ) !! Gets the number of nodes for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ) :: rst !! The number of nodes. rst = 2 end function ! ------------------------------------------------------------------------------ pure function b3d_dof_per_node ( this ) result ( rst ) !! Gets the number of degrees of freedom per node. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ) :: rst !! The number of DOF per node. rst = 6 end function ! ------------------------------------------------------------------------------ pure function b3d_get_node ( this , i ) result ( rst ) !! Gets the requested node from the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ) :: i !! The local index of the node to retrieve. type ( node ) :: rst !! The requested node. if ( i == 1 ) then rst = this % node_1 else rst = this % node_2 end if end function ! ------------------------------------------------------------------------------ pure subroutine b3d_terminal_nodes ( this , i1 , i2 ) !! Gets the terminal node numbers for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( out ) :: i1 !! The index of the node at the head of the element. integer ( int32 ), intent ( out ) :: i2 !! The index of the node at the tail of the element. i1 = 1 i2 = 2 end subroutine ! ------------------------------------------------------------------------------ pure function b3d_shape_function ( this , i , s ) result ( rst ) !! Evaluates the i-th shape function at natural coordinate s. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ) :: i !! The index of the shape function to evaluate. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate !! the shape function. real ( real64 ) :: rst !! The value of the i-th shape function at s. ! Local Variables real ( real64 ) :: l ! Process select case ( i ) case ( 1 ) rst = 0.5d0 * ( 1.0d0 - s ( 1 )) case ( 2 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 2.0d0 + s ( 1 )) case ( 3 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 2.0d0 + s ( 1 )) case ( 4 ) rst = 0.5d0 * ( 1.0d0 - s ( 1 )) case ( 5 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 - s ( 1 )) case ( 6 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 - s ( 1 )) case ( 7 ) rst = 0.5d0 * ( 1.0d0 + s ( 1 )) case ( 8 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( 2.0d0 - s ( 1 )) case ( 9 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( 2.0d0 - s ( 1 )) case ( 10 ) rst = 0.5d0 * ( 1.0d0 + s ( 1 )) case ( 11 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 + s ( 1 )) case ( 12 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 + s ( 1 )) case default rst = 0.0d0 end select end function ! ------------------------------------------------------------------------------ pure function b3d_shape_function_matrix_3d ( this , s ) result ( rst ) !! Computes the shape function matrix for a beam element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the shape !! functions. real ( real64 ), allocatable , dimension (:,:) :: rst !! The shape function matrix. ! Local Variables real ( real64 ) :: n1 , n2 , n3 , n4 , n5 , n6 , n7 , n8 , n9 , n10 , n11 , n12 , l ! Initialization allocate ( rst ( 4 , 12 ), source = 0.0d0 ) l = this % length () ! Process n1 = this % evaluate_shape_function ( 1 , s ) n2 = this % evaluate_shape_function ( 2 , s ) n3 = this % evaluate_shape_function ( 3 , s ) n4 = this % evaluate_shape_function ( 4 , s ) n5 = - 0.5d0 * l * this % evaluate_shape_function ( 5 , s ) n6 = 0.5d0 * l * this % evaluate_shape_function ( 6 , s ) n7 = this % evaluate_shape_function ( 7 , s ) n8 = this % evaluate_shape_function ( 8 , s ) n9 = this % evaluate_shape_function ( 9 , s ) n10 = this % evaluate_shape_function ( 10 , s ) n11 = 0.5d0 * l * this % evaluate_shape_function ( 11 , s ) n12 = - 0.5d0 * l * this % evaluate_shape_function ( 12 , s ) rst ( 1 , 1 ) = n1 rst ( 2 , 2 ) = n2 rst ( 3 , 3 ) = n3 rst ( 4 , 4 ) = n4 rst ( 3 , 5 ) = n5 rst ( 2 , 6 ) = n6 rst ( 1 , 7 ) = n7 rst ( 2 , 8 ) = n8 rst ( 3 , 9 ) = n9 rst ( 4 , 10 ) = n10 rst ( 3 , 11 ) = n11 rst ( 2 , 12 ) = n12 end function ! ------------------------------------------------------------------------------ pure function b3d_strain_disp_matrix_3d ( this , s ) result ( rst ) !! Computes the strain-displacement matrix for a 3D beam element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The strain-displacement matrix. ! Local Variables real ( real64 ) :: l , dsdx , dn1ds , dn2ds , dn3ds , dn4ds , dn5ds , dn6ds , & dn7ds , dn8ds , dn9ds , dn10ds , dn11ds , dn12ds ! Initialization allocate ( rst ( 4 , 12 ), source = 0.0d0 ) ! Process l = this % length () dsdx = 2.0d0 / l ! s = 2 * x / L - 1, so ds/dx = 2 / L dn1ds = shape_function_derivative ( 1 , this , s , 1 ) dn2ds = shape_function_second_derivative ( 2 , this , s , 1 ) dn3ds = shape_function_second_derivative ( 3 , this , s , 1 ) dn4ds = shape_function_derivative ( 4 , this , s , 1 ) dn5ds = - 0.5d0 * l * shape_function_second_derivative ( 5 , this , s , 1 ) dn6ds = 0.5d0 * l * shape_function_second_derivative ( 6 , this , s , 1 ) dn7ds = shape_function_derivative ( 7 , this , s , 1 ) dn8ds = shape_function_second_derivative ( 8 , this , s , 1 ) dn9ds = shape_function_second_derivative ( 9 , this , s , 1 ) dn10ds = shape_function_derivative ( 10 , this , s , 1 ) dn11ds = 0.5d0 * l * shape_function_second_derivative ( 11 , this , s , 1 ) dn12ds = - 0.5d0 * l * shape_function_second_derivative ( 12 , this , s , 1 ) ! Build the matrix rst ( 1 , 1 ) = dn1ds * dsdx rst ( 2 , 2 ) = dn2ds * dsdx ** 2 rst ( 3 , 3 ) = dn3ds * dsdx ** 2 rst ( 4 , 4 ) = dn4ds * dsdx rst ( 3 , 5 ) = dn5ds * dsdx ** 2 rst ( 2 , 6 ) = dn6ds * dsdx ** 2 rst ( 1 , 7 ) = dn7ds * dsdx rst ( 2 , 8 ) = dn8ds * dsdx ** 2 rst ( 3 , 9 ) = dn9ds * dsdx ** 2 rst ( 4 , 10 ) = dn10ds * dsdx rst ( 3 , 11 ) = dn11ds * dsdx ** 2 rst ( 2 , 12 ) = dn12ds * dsdx ** 2 end function ! ------------------------------------------------------------------------------ pure function b3d_constitutive_matrix ( this ) result ( rst ) !! Computes the constitutive matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Process allocate ( rst ( 4 , 4 ), source = 0.0d0 ) rst ( 1 , 1 ) = this % area * this % material % modulus rst ( 2 , 2 ) = this % Izz * this % material % modulus rst ( 3 , 3 ) = this % Iyy * this % material % modulus rst ( 4 , 4 ) = this % Ixx * this % material % modulus / & ( 2.0d0 * ( 1.0d0 + this % material % poissons_ratio )) end function ! ------------------------------------------------------------------------------ pure function b3d_jacobian ( this , s ) result ( rst ) !! Computes the Jacobian matrix for a 3D beam element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The Jacobian matrix. rst = reshape ([ 0.5d0 * this % length ()], [ 1 , 1 ]) end function ! ------------------------------------------------------------------------------ pure function b3d_rotation_matrix ( this ) result ( rst ) !! Computes the rotation matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 12-by-12 rotation matrix. ! Local Variables real ( real64 ) :: i ( 3 ), j ( 3 ), k ( 3 ) ! Define the unit vectors i = [ & this % node_2 % x - this % node_1 % x , & this % node_2 % y - this % node_1 % y , & this % node_2 % z - this % node_1 % z & ] i = i / norm2 ( i ) k = normal_vector_to_line ( this % node_1 , this % node_2 , this % orientation_point ) j = [ & k ( 2 ) * i ( 3 ) - k ( 3 ) * i ( 2 ), & k ( 3 ) * i ( 1 ) - k ( 1 ) * i ( 3 ), & k ( 1 ) * i ( 2 ) - k ( 2 ) * i ( 1 ) & ] ! Construct the matrix allocate ( rst ( 12 , 12 ), source = 0.0d0 ) rst ( 1 : 3 , 1 : 3 ) = rotate ( i , j , k ) rst ( 4 : 6 , 4 : 6 ) = rst ( 1 : 3 , 1 : 3 ) rst ( 7 : 9 , 7 : 9 ) = rst ( 1 : 3 , 1 : 3 ) rst ( 10 : 12 , 10 : 12 ) = rst ( 1 : 3 , 1 : 3 ) end function ! ------------------------------------------------------------------------------ ! https://www.researchgate.net/publication/352816965_3-D_Beam_Finite_Element_Programming_-A_Practical_Guide_Part_1 ! https://homes.civil.aau.dk/jc/FemteSemester/Beams3D.pdf ! https://www.sesamx.io/blog/beam_finite_element/ ! https://www.brown.edu/Departments/Engineering/Courses/En2340/Projects/Projects_2015/Wenqiang_Fan.pdf ! https://www.mm.bme.hu/~gyebro/files/ans_help_v182/ans_thry/thy_shp2.html#shp3d2node pure function b3d_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: A , E , Iyy , Izz , Jxx , G , L real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization A = this % area Jxx = this % Ixx Iyy = this % Iyy Izz = this % Izz E = this % material % modulus G = E / ( 2.0d0 * ( 1.0d0 + this % material % poissons_ratio )) L = this % length () ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Construct the stiffness matrix allocate ( rst ( 12 , 12 ), source = 0.0d0 ) rst ( 1 , 1 ) = A * E / L rst ( 7 , 1 ) = - rst ( 1 , 1 ) rst ( 2 , 2 ) = 1.2d1 * E * Izz / L ** 3 rst ( 6 , 2 ) = 6.0d0 * E * Izz / L ** 2 rst ( 8 , 2 ) = - rst ( 2 , 2 ) rst ( 12 , 2 ) = rst ( 6 , 2 ) rst ( 3 , 3 ) = 1.2d1 * E * Iyy / L ** 3 rst ( 5 , 3 ) = - 6.0d0 * E * Iyy / L ** 2 rst ( 9 , 3 ) = - rst ( 3 , 3 ) rst ( 11 , 3 ) = rst ( 5 , 3 ) rst ( 4 , 4 ) = G * Jxx / L rst ( 10 , 4 ) = - rst ( 4 , 4 ) rst ( 3 , 5 ) = rst ( 5 , 3 ) rst ( 5 , 5 ) = 4.0d0 * E * Iyy / L rst ( 9 , 5 ) = - rst ( 11 , 3 ) rst ( 11 , 5 ) = 2.0d0 * E * Iyy / L rst ( 2 , 6 ) = rst ( 6 , 2 ) rst ( 6 , 6 ) = 4.0d0 * E * Izz / L rst ( 8 , 6 ) = - rst ( 12 , 2 ) rst ( 12 , 6 ) = 2.0d0 * E * Izz / L rst ( 1 , 7 ) = rst ( 7 , 1 ) rst ( 7 , 7 ) = rst ( 1 , 1 ) rst ( 2 , 8 ) = rst ( 8 , 2 ) rst ( 6 , 8 ) = rst ( 8 , 6 ) rst ( 8 , 8 ) = rst ( 2 , 2 ) rst ( 12 , 8 ) = - rst ( 6 , 2 ) rst ( 3 , 9 ) = rst ( 9 , 3 ) rst ( 5 , 9 ) = rst ( 9 , 5 ) rst ( 9 , 9 ) = rst ( 3 , 3 ) rst ( 11 , 9 ) = - rst ( 5 , 3 ) rst ( 4 , 10 ) = rst ( 10 , 4 ) rst ( 10 , 10 ) = rst ( 4 , 4 ) rst ( 3 , 11 ) = rst ( 11 , 3 ) rst ( 5 , 11 ) = rst ( 11 , 5 ) rst ( 9 , 11 ) = rst ( 11 , 9 ) rst ( 11 , 11 ) = rst ( 5 , 5 ) rst ( 2 , 12 ) = rst ( 12 , 2 ) rst ( 6 , 12 ) = rst ( 12 , 6 ) rst ( 8 , 12 ) = rst ( 12 , 8 ) rst ( 12 , 12 ) = rst ( 6 , 6 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function b3d_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: rho , L real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization rho = this % material % density L = this % length () ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Compute the mass matrix allocate ( rst ( 12 , 12 ), source = 0.0d0 ) rst ( 1 , 1 ) = L * rho / 3.0d0 rst ( 7 , 1 ) = L * rho / 6.0d0 rst ( 2 , 2 ) = 1.3d1 * L * rho / 3.5d1 rst ( 6 , 2 ) = 1.1d1 * rho * L ** 2 / 2.1d2 rst ( 8 , 2 ) = 9.0d0 * L * rho / 7.0d1 rst ( 12 , 2 ) = - 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 3 , 3 ) = 1.3d0 * rho * L / 3.5d1 rst ( 5 , 3 ) = - 1.1d0 * rho * L ** 2 / 2.1d2 rst ( 9 , 3 ) = 9.0d0 * rho * L / 7.0d1 rst ( 11 , 3 ) = 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 4 , 4 ) = rho * L / 3.0d0 rst ( 10 , 4 ) = rho * L / 6.0d0 rst ( 3 , 5 ) = rst ( 5 , 3 ) rst ( 5 , 5 ) = rho * L ** 3 / 1.05d2 rst ( 9 , 5 ) = - 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 11 , 5 ) = - rho * L ** 3 / 1.4d2 rst ( 2 , 6 ) = rst ( 6 , 2 ) rst ( 6 , 6 ) = rho * L ** 3 / 1.05d2 rst ( 8 , 6 ) = 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 12 , 6 ) = - rho * L ** 3 / 1.4d2 rst ( 1 , 7 ) = rst ( 7 , 1 ) rst ( 7 , 7 ) = rst ( 1 , 1 ) rst ( 2 , 8 ) = rst ( 8 , 2 ) rst ( 6 , 8 ) = rst ( 8 , 6 ) rst ( 8 , 8 ) = rst ( 2 , 2 ) rst ( 12 , 8 ) = - 1.1d1 * rho * L ** 2 / 2.1d2 rst ( 3 , 9 ) = rst ( 9 , 3 ) rst ( 5 , 9 ) = rst ( 9 , 5 ) rst ( 9 , 9 ) = rst ( 3 , 3 ) rst ( 11 , 9 ) = 1.1d1 * rho * L ** 2 / 2.1d2 rst ( 4 , 10 ) = rst ( 10 , 4 ) rst ( 10 , 10 ) = rst ( 4 , 4 ) rst ( 3 , 11 ) = rst ( 11 , 3 ) rst ( 9 , 11 ) = rst ( 11 , 9 ) rst ( 11 , 11 ) = rst ( 5 , 5 ) rst ( 2 , 12 ) = rst ( 12 , 2 ) rst ( 6 , 12 ) = rst ( 12 , 6 ) rst ( 8 , 12 ) = rst ( 12 , 8 ) rst ( 12 , 12 ) = rst ( 6 , 6 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_structural.f90.html"},{"title":"dynamics_system_id.f90 – DYNAMICS","text":"Contents Modules dynamics_system_id Source Code dynamics_system_id.f90 Source Code module dynamics_system_id use iso_fortran_env use ferror use dynamics_error_handling use diffeq use fstats implicit none private public :: dynamic_system_measurement public :: model_information public :: siso_model_fit_least_squares public :: ode_integrator public :: regression_statistics public :: iteration_controls public :: lm_solver_options public :: convergence_info public :: iteration_update public :: constraint_equations interface subroutine constraint_equations ( xg , fg , xc , p , fc , args ) !! An interface to a set of routines for defining constraint !! equations to the fitting process. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ), dimension (:) :: xg !! An N-element array containing the N independent variable !! values for the N differential equation solution points. real ( real64 ), intent ( in ), dimension (:) :: fg !! An N-element array containing the N differential equation !! solution points. real ( real64 ), intent ( in ), dimension (:) :: xc !! An M-element array containing the M independent variable !! values for the M constraint equations. real ( real64 ), intent ( in ), dimension (:) :: p !! An array containing the model parameters. real ( real64 ), intent ( out ), dimension (:) :: fc !! An M-element array where the values of the constraint !! equations should be written. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to pass data in/out !! of this routine. end subroutine end interface type dynamic_system_measurement !! A container of a single measurement data set. real ( real64 ), allocatable , dimension (:) :: t !! The time points at which the measurements were taken. real ( real64 ), allocatable , dimension (:) :: output !! The output data. real ( real64 ), allocatable , dimension (:) :: input !! The input data. end type type model_information !! A container for model information. real ( real64 ), allocatable , dimension (:) :: model !! An array containing the model parameters. class ( base_interpolator ), pointer :: excitation !! An interpolation object allowing sampling of the excitation !! function. class ( * ), pointer :: user_info !! Information the user has passed along. end type type regression_information !! A container of information being shared with the regression function. integer ( int32 ), allocatable , dimension (:,:) :: start_stop !! An N-by-2 matrix containing the starting indices of each data !! set in the first column, and the ending indices of each data !! set in the second column. class ( ode_integrator ), pointer :: integrator !! A pointer to the ODE integrator. integer ( int32 ) :: solution_index !! The column index of the solution component to extract from the !! ODE solver output. Do not account for the time vector (e.g. !! enter a value of 1 to extract the first solution component.) real ( real64 ), allocatable , dimension (:,:) :: initial_conditions !! The initial conditions array to pass to the ODE solver. real ( real64 ), allocatable , dimension (:) :: excitation_data !! An array of excitation data to pass to the ODE solver. procedure ( ode ), pointer , nopass :: ode_routine !! The routine, defined by the calling code, containing the ODE's !! to solve. logical :: uses_constraints !! True if constraint equations are to be utilized; else, false. procedure ( constraint_equations ), pointer , nopass :: constraints !! A pointer to the constraint equations routine. class ( * ), pointer :: user_info !! Information the user has passed along. end type interface siso_model_fit_least_squares module procedure :: siso_model_fit_least_squares_1 module procedure :: siso_model_fit_least_squares_2 end interface contains ! ------------------------------------------------------------------------------ subroutine siso_model_fit_least_squares_1 ( fcn , x , ic , p , integrator , ind , & maxp , minp , stats , alpha , controls , settings , info , status , cov , xc , yc , & constraints , weights , args , & err ) !! Attempts to fit a model of a single-intput, single-output (SISO) dynamic !! system by means of an iterative least-squares solver. The algorithm !! computes the solution to the differential equations numerically, and !! compares the output to the known solution via a Levenberg-Marquardt !! least-squares solver. procedure ( ode ), pointer , intent ( in ) :: fcn !! The routine containing the ODE's being fit. To communicate !! model parameters and other relevant information, an instance of the !! [[model_information]] type is passed to the optional argument of this !! routine. Use the \"select type\" construct to access this information. class ( dynamic_system_measurement ), intent ( in ), dimension (:) :: x !! An M-element array of arrays with each array containing the measured !! input and output of the system being identified. real ( real64 ), intent ( in ), dimension (:) :: ic !! The initial condition vector for the equations in fcn. real ( real64 ), intent ( inout ), dimension (:) :: p !! An N-element array containing an initial guess at the parameters. !! On output, the computed model parameters. class ( ode_integrator ), intent ( inout ), optional , target :: integrator !! The integrator to use when solving the system equations. If not !! supplied, the default integrator will be used. The default !! integrator is a Runge-Kutta integrator (Dormand-Prince). integer ( int32 ), intent ( in ), optional :: ind !! The index of the ODE in fcn providing the output to fit. If !! no value is supplied, a value of 1 will be utilized. real ( real64 ), intent ( in ), optional , dimension (:) :: maxp !! An optional N-element array that can be used as upper limits on the !! parameter values. If no upper limit is requested for a particular !! parameter, utilize a very large value. The internal default is to !! utilize huge() as a value. real ( real64 ), intent ( in ), optional , dimension (:) :: minp !! An optional N-element array that can be used as lower limits on the !! parameter values. If no lower limit is requested for a particalar !! parameter, utilize a very large magnitude, but negative, value. The !! internal default is to utilize -huge() as a value. type ( regression_statistics ), intent ( out ), optional , dimension (:) :: stats !! An optional N-element array that, if supplied, will be used to !! return statistics about the fit for each parameter. real ( real64 ), intent ( in ), optional :: alpha !! The significance level at which to evaluate the confidence !! intervals. The default value is 0.05 such that a 95% confidence !! interval is calculated. type ( iteration_controls ), intent ( in ), optional :: controls !! An optional input providing custom iteration controls. type ( lm_solver_options ), intent ( in ), optional :: settings !! An optional input providing custom settings for the solver. type ( convergence_info ), intent ( out ), optional :: info !! An optional output that can be used to gain information about the !! iterative solution and the nature of the convergence. procedure ( iteration_update ), pointer , intent ( in ), optional :: status !! An optional pointer to a routine that can be used to extract !! iteration information. real ( real64 ), intent ( out ), optional , dimension (:,:) :: cov !! An optional N-by-N matrix that, if supplied, will be used to return !! the covariance matrix. real ( real64 ), intent ( in ), optional , dimension (:) :: xc !! An optional NC-element array containing the values of the independent !! variable at which the constraint equations are defined. real ( real64 ), intent ( in ), optional , dimension (:) :: yc !! An optional NC-element array containing the constraint function !! values at xc. procedure ( constraint_equations ), pointer , optional :: constraints !! An optional input, that must be utilized with the xc and yc inputs, !! but allows for the implementation of additional constraints on the !! solution outside of the differential equations being fitted. An !! example usage would be an additional set of quasi-static tests that !! could help identify a stiffness term, for instance. Other uses of !! course can be imagined. real ( real64 ), intent ( in ), optional , dimension (:) :: weights !! An optional array containing weighting factors for every equation. class ( * ), intent ( inout ), optional , target :: args !! User-defined information to pass along to fcn. These arguments, !! if supplied, will be passed through to fcn by means of the !! [[model_information]] type. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. ! Local Variables integer ( int32 ) :: i , i1 , i2 , n , ni , npts , nc , flag real ( real64 ), allocatable , dimension (:) :: t , f , ymod , resid class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( runge_kutta_45 ), target :: default_ode_solver type ( regression_information ) :: addinfo procedure ( regression_function ), pointer :: fcnptr type ( iteration_controls ) :: def_tol ; ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if if ( present ( xc ) . and . present ( yc ) . and . present ( constraints )) then nc = size ( xc ) if ( size ( yc ) /= nc ) then call report_array_size_error ( \"siso_model_fit_least_squares_1\" , & \"yc\" , nc , size ( yc ), errmgr ) return end if else nc = 0 end if n = size ( x ) fcnptr => nlsq_fun if ( present ( controls )) then def_tol = controls else call def_tol % set_to_default () def_tol % change_in_solution_tolerance = 1.0d-12 def_tol % residual_tolerance = sqrt ( epsilon ( 1.0d0 )) end if allocate ( addinfo % start_stop ( n , 2 ), stat = flag ) if ( flag /= 0 ) go to 100 i1 = 1 i2 = 0 npts = 0 do i = 1 , n ni = size ( x ( i )% t ) npts = npts + ni i2 = i2 + ni addinfo % start_stop ( i , 1 ) = i1 addinfo % start_stop ( i , 2 ) = i2 i1 = i2 + 1 end do npts = npts + nc allocate ( t ( npts ), f ( npts ), addinfo % excitation_data ( npts ), ymod ( npts ), & resid ( npts ), stat = flag ) if ( flag /= 0 ) go to 100 do i = 1 , n i1 = addinfo % start_stop ( i , 1 ) i2 = addinfo % start_stop ( i , 2 ) t ( i1 : i2 ) = x ( i )% t addinfo % excitation_data ( i1 : i2 ) = x ( i )% input f ( i1 : i2 ) = x ( i )% output end do if ( nc > 0 ) then i1 = i2 + 1 t ( i1 : npts ) = xc f ( i1 : npts ) = yc end if if ( present ( integrator )) then addinfo % integrator => integrator else addinfo % integrator => default_ode_solver end if allocate ( addinfo % initial_conditions ( 1 , size ( ic ))) addinfo % initial_conditions ( 1 ,:) = ic if ( present ( ind )) then addinfo % solution_index = ind else addinfo % solution_index = 1 end if addinfo % ode_routine => fcn if ( nc > 0 ) then addinfo % uses_constraints = . true . addinfo % constraints => constraints else addinfo % uses_constraints = . false . end if if ( present ( args )) addinfo % user_info => args ! Solve the system call nonlinear_least_squares ( fcnptr , t , f , p , ymod , resid , maxp = maxp , & minp = minp , stats = stats , alpha = alpha , controls = def_tol , & settings = settings , info = info , status = status , cov = cov , & args = addinfo , err = errmgr , weights = weights ) if ( errmgr % has_error_occurred ()) return ! End return ! Memory Error 100 continue call report_memory_error ( \"siso_model_fit_least_squares_1\" , flag , errmgr ) end subroutine ! -------------------- subroutine siso_model_fit_least_squares_2 ( fcn , x , ic , p , integrator , ind , & maxp , minp , stats , alpha , controls , settings , info , status , cov , xc , yc , & constraints , weights , args , & err ) !! Attempts to fit a model of a single-intput, single-output (SISO) dynamic !! system by means of an iterative least-squares solver. The algorithm !! computes the solution to the differential equations numerically, and !! compares the output to the known solution via a Levenberg-Marquardt !! least-squares solver. procedure ( ode ), pointer , intent ( in ) :: fcn !! The routine containing the ODE's being fit. To communicate !! model parameters and other relevant information, an instance of the !! [[model_information]] type is passed to the optional argument of this !! routine. Use the \"select type\" construct to access this information. class ( dynamic_system_measurement ), intent ( in ), dimension (:) :: x !! An M-element array of arrays with each array containing the measured !! input and output of the system being identified. real ( real64 ), intent ( in ), dimension (:,:) :: ic !! An M-by-NEQN matrix of initial condition vectors for the NEQN !! equations in fcn, one set for each of the M sets of data in x. real ( real64 ), intent ( inout ), dimension (:) :: p !! An N-element array containing an initial guess at the parameters. !! On output, the computed model parameters. class ( ode_integrator ), intent ( inout ), optional , target :: integrator !! The integrator to use when solving the system equations. If not !! supplied, the default integrator will be used. The default !! integrator is a Runge-Kutta integrator (Dormand-Prince). integer ( int32 ), intent ( in ), optional :: ind !! The index of the ODE in fcn providing the output to fit. If !! no value is supplied, a value of 1 will be utilized. real ( real64 ), intent ( in ), optional , dimension (:) :: maxp !! An optional N-element array that can be used as upper limits on the !! parameter values. If no upper limit is requested for a particular !! parameter, utilize a very large value. The internal default is to !! utilize huge() as a value. real ( real64 ), intent ( in ), optional , dimension (:) :: minp !! An optional N-element array that can be used as lower limits on the !! parameter values. If no lower limit is requested for a particalar !! parameter, utilize a very large magnitude, but negative, value. The !! internal default is to utilize -huge() as a value. type ( regression_statistics ), intent ( out ), optional , dimension (:) :: stats !! An optional N-element array that, if supplied, will be used to !! return statistics about the fit for each parameter. real ( real64 ), intent ( in ), optional :: alpha !! The significance level at which to evaluate the confidence !! intervals. The default value is 0.05 such that a 95% confidence !! interval is calculated. type ( iteration_controls ), intent ( in ), optional :: controls !! An optional input providing custom iteration controls. type ( lm_solver_options ), intent ( in ), optional :: settings !! An optional input providing custom settings for the solver. type ( convergence_info ), intent ( out ), optional :: info !! An optional output that can be used to gain information about the !! iterative solution and the nature of the convergence. procedure ( iteration_update ), pointer , intent ( in ), optional :: status !! An optional pointer to a routine that can be used to extract !! iteration information. real ( real64 ), intent ( out ), optional , dimension (:,:) :: cov !! An optional N-by-N matrix that, if supplied, will be used to return !! the covariance matrix. real ( real64 ), intent ( in ), optional , dimension (:) :: xc !! An optional NC-element array containing the values of the independent !! variable at which the constraint equations are defined. real ( real64 ), intent ( in ), optional , dimension (:) :: yc !! An optional NC-element array containing the constraint function !! values at xc. procedure ( constraint_equations ), pointer , optional :: constraints !! An optional input, that must be utilized with the xc and yc inputs, !! but allows for the implementation of additional constraints on the !! solution outside of the differential equations being fitted. An !! example usage would be an additional set of quasi-static tests that !! could help identify a stiffness term, for instance. Other uses of !! course can be imagined. real ( real64 ), intent ( in ), optional , dimension (:) :: weights !! An optional array containing weighting factors for every equation. class ( * ), intent ( inout ), optional , target :: args !! User-defined information to pass along to fcn. These arguments, !! if supplied, will be passed through to fcn by means of the !! [[model_information]] type. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. ! Local Variables integer ( int32 ) :: i , i1 , i2 , n , ni , npts , nc , flag real ( real64 ), allocatable , dimension (:) :: t , f , ymod , resid class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( runge_kutta_45 ), target :: default_ode_solver type ( regression_information ) :: addinfo procedure ( regression_function ), pointer :: fcnptr type ( iteration_controls ) :: def_tol ! Initialization & Error Checking if ( present ( err )) then errmgr => err else errmgr => deferr end if if ( present ( xc ) . and . present ( yc ) . and . present ( constraints )) then nc = size ( xc ) if ( size ( yc ) /= nc ) then call report_array_size_error ( \"siso_model_fit_least_squares_2\" , & \"yc\" , nc , size ( yc ), errmgr ) return end if else nc = 0 end if n = size ( x ) fcnptr => nlsq_fun if ( present ( controls )) then def_tol = controls else call def_tol % set_to_default () def_tol % change_in_solution_tolerance = 1.0d-12 def_tol % residual_tolerance = sqrt ( epsilon ( 1.0d0 )) end if if ( size ( ic , 1 ) /= n ) then call report_matrix_size_error ( \"siso_model_fit_least_squares_2\" , \"ic\" , & n , size ( ic , 2 ), size ( ic , 1 ), size ( ic , 2 ), errmgr ) return end if allocate ( addinfo % start_stop ( n , 2 ), stat = flag ) if ( flag /= 0 ) go to 100 i1 = 1 i2 = 0 npts = 0 do i = 1 , n ni = size ( x ( i )% t ) npts = npts + ni i2 = i2 + ni addinfo % start_stop ( i , 1 ) = i1 addinfo % start_stop ( i , 2 ) = i2 i1 = i2 + 1 end do npts = npts + nc allocate ( t ( npts ), f ( npts ), addinfo % excitation_data ( npts ), ymod ( npts ), & resid ( npts ), stat = flag ) if ( flag /= 0 ) go to 100 do i = 1 , n i1 = addinfo % start_stop ( i , 1 ) i2 = addinfo % start_stop ( i , 2 ) t ( i1 : i2 ) = x ( i )% t addinfo % excitation_data ( i1 : i2 ) = x ( i )% input f ( i1 : i2 ) = x ( i )% output end do if ( nc > 0 ) then i1 = i2 + 1 t ( i1 : npts ) = xc f ( i1 : npts ) = yc end if if ( present ( integrator )) then addinfo % integrator => integrator else addinfo % integrator => default_ode_solver end if addinfo % initial_conditions = ic if ( present ( ind )) then addinfo % solution_index = ind else addinfo % solution_index = 1 end if addinfo % ode_routine => fcn if ( nc > 0 ) then addinfo % uses_constraints = . true . addinfo % constraints => constraints else addinfo % uses_constraints = . false . end if if ( present ( args )) addinfo % user_info => args ! Solve the system call nonlinear_least_squares ( fcnptr , t , f , p , ymod , resid , maxp = maxp , & minp = minp , stats = stats , alpha = alpha , controls = def_tol , & settings = settings , info = info , status = status , cov = cov , & args = addinfo , err = errmgr , weights = weights ) if ( errmgr % has_error_occurred ()) return ! End return ! Memory Error 100 continue call report_memory_error ( \"siso_model_fit_least_squares_2\" , flag , errmgr ) end subroutine ! -------------------- subroutine nlsq_fun ( t , p , f , check , args ) !! The routine called by the nonlinear least-squares solver from the !! siso_model_fit_least_squares routine. real ( real64 ), intent ( in ), dimension (:) :: t !! All of the time values from every data set supplied to the !! least-squares solver. The args instance contains information on !! how to break apart this array. real ( real64 ), intent ( in ), dimension (:) :: p !! An array containing the model parameters. real ( real64 ), intent ( out ), dimension (:) :: f !! An array, the same size as t, where the function values will be !! written. logical , intent ( out ) :: check !! Set to true to force a stop to the iteration process; else, set !! to false to allow iterations to proceed normally. class ( * ), intent ( inout ), optional :: args !! A regression_information object containing information on how to !! arrange and solve the differential equations. ! Local Variables type ( model_information ) :: ode_info integer ( int32 ) :: i , n , ind , i1 , i2 integer ( int32 ), allocatable , dimension (:,:) :: limits real ( real64 ), allocatable , dimension (:) :: excitation , ici real ( real64 ), allocatable , dimension (:,:) :: sol , ic class ( ode_integrator ), pointer :: integrator type ( linear_interpolator ), target :: forcing_function type ( ode_container ) :: mdl type ( errors ) :: err logical :: uses_constraints procedure ( constraint_equations ), pointer :: constraints class ( * ), pointer :: user_info ! Get the supplied information select type ( args ) class is ( regression_information ) limits = args % start_stop integrator => args % integrator ind = args % solution_index + 1 ! +1 accounts for the time vector excitation = args % excitation_data ic = args % initial_conditions mdl % fcn => args % ode_routine if ( associated ( args % user_info )) then ode_info % user_info => args % user_info user_info => args % user_info end if uses_constraints = args % uses_constraints if ( uses_constraints ) constraints => args % constraints end select ! Initialization check = . false . n = size ( limits , 1 ) ode_info % model = p ! Cycle over each segment and compute the solution do i = 1 , n ! Get the locations within the array at which the relevant data is ! located i1 = limits ( i , 1 ) i2 = limits ( i , 2 ) ! Set up the interpolator for the forcing term call forcing_function % initialize ( t ( i1 : i2 ), excitation ( i1 : i2 ), err = err ) if ( err % has_error_occurred ()) go to 10 ode_info % excitation => forcing_function ! Solve the ODE's if ( size ( ic , 1 ) == 1 ) then ici = ic ( 1 ,:) else ici = ic ( i ,:) end if call integrator % clear_buffer () call integrator % solve ( mdl , t ( i1 : i2 ), ici , args = ode_info , err = err ) if ( err % has_error_occurred ()) go to 10 sol = integrator % get_solution () f ( i1 : i2 ) = sol (:, ind ) end do ! Constraints if ( uses_constraints ) then if ( associated ( user_info )) then call constraints ( t ( 1 : i2 ), f ( 1 : i2 ), t ( i2 + 1 :), p , f ( i2 + 1 :), & args = user_info ) else call constraints ( t ( 1 : i2 ), f ( 1 : i2 ), t ( i2 + 1 :), p , f ( i2 + 1 :)) end if end if ! End return ! Error Handling 10 continue check = . true . ! terminate iterations return end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_system_id.f90.html"},{"title":"dynamics_vibrations.f90 – DYNAMICS","text":"Contents Modules dynamics_vibrations Source Code dynamics_vibrations.f90 Source Code module dynamics_vibrations use iso_fortran_env use peaks use ieee_arithmetic implicit none private public :: q_factor public :: estimate_bandwidth public :: logarithmic_decrement public :: damping_from_log_decrement public :: find_free_response_properties public :: rise_time public :: find_settling_amplitude public :: damping_from_fractional_overshoot public :: evaluate_step_response contains ! ------------------------------------------------------------------------------ pure elemental function q_factor ( zeta ) result ( rst ) !! Estimates the Q-factor for a vibratory system. The Q-factor is computed !! Q = \\frac{1}{2 \\zeta}. real ( real64 ), intent ( in ) :: zeta !! The damping ratio. real ( real64 ) :: rst !! The Q-factor. ! Process rst = 1.0d0 / ( 2.0d0 * zeta ) end function ! ------------------------------------------------------------------------------ pure elemental function estimate_bandwidth ( fn , zeta ) result ( rst ) !! Estimates the bandwidth of the resonant mode of a vibratory system. !! The bandwidth is the width of the range of frequencies for which the !! energy is at least half its peak value and is computed as !! \\Delta f = \\frac{f_n}{Q}. real ( real64 ), intent ( in ) :: fn !! The resonant frequency. The units are not important; however, !! the units of the output will be the same as the units of this !! parameter. real ( real64 ), intent ( in ) :: zeta !! The damping ratio. real ( real64 ) :: rst !! The bandwidth. ! Process rst = fn / q_factor ( zeta ) end function ! ------------------------------------------------------------------------------ pure elemental function logarithmic_decrement ( x1 , x2 , n ) result ( rst ) !! Computes the logarithmic decrement given the value of two successive !! peaks in the time history of the free vibratory response of the system. !! The logarithmic decrement is calculated as follows. !! !! \\delta = \\frac{1}{N} \\ln \\left( \\frac{x(t)}{x(t + N T)} \\right) = !! \\frac{1}{N} \\ln \\left( \\frac{x_1}{x_2} \\right) real ( real64 ), intent ( in ) :: x1 !! The amplitude of the first peak. real ( real64 ), intent ( in ) :: x2 !! The amplitude of the second peak that occurs N periods after the !! first. integer ( int32 ), intent ( in ) :: n !! The number of periods of oscillation seperating the two peaks. real ( real64 ) :: rst !! The logarithmic decrement \\delta. ! Process rst = ( 1.0d0 / n ) * log ( x1 / x2 ) end function ! ------------------------------------------------------------------------------ pure elemental function damping_from_log_decrement ( delta ) result ( rst ) !! Computes the damping ratio from the logarithmic decrement \\delta. !! The damping ratio is related to the logarithmic decrement by the !! following relationship. !! !! \\zeta = \\frac{\\delta}{\\sqrt{4 \\pi^2 + \\delta^2}} real ( real64 ), intent ( in ) :: delta !! The logarithmic decrement. real ( real64 ) :: rst !! The damping ratio. ! Process real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) rst = delta / sqrt ( 4.0d0 * pi ** 2 + delta ** 2 ) end function ! ------------------------------------------------------------------------------ subroutine find_free_response_properties ( t , x , delta , fn , x1 , x2 , t1 , t2 , s , n ) !! Given a free-response time history, this routine attempts to find the !! logarithmic decrement and resonant frequency of a vibratory system. The !! logarithmic decrement is estimated by finding successive peaks by !! means of peak detection. real ( real64 ), intent ( in ), dimension (:) :: t !! An N-element array containing the values in time real ( real64 ), intent ( in ), dimension (:) :: x !! An N-element array containing the response sampled at the time points !! given in t. real ( real64 ), intent ( out ) :: delta !! The logarithmic decrement estimate. If sufficient peaks cannot be !! located, the routine returns NaN. real ( real64 ), intent ( out ) :: fn !! The damped resonant frequency in units of Hz, assuming that the !! time values are in seconds. If the time units are not in seconds, !! the units will be cycle/unit time with unit time being the units !! in which t is supplied. If sufficient peaks cannot be located, the !! routine returns NaN. real ( real64 ), intent ( out ), optional :: x1 !! An optional parameter that, if provided, allows for the routine to !! return the amplitude of the first peak. If sufficient peaks cannot !! be located, the routine returns NaN. real ( real64 ), intent ( out ), optional :: x2 !! An optional parameter that, if provided, allows for the routine to !! return the amplitude of the second peak. If sufficient peaks cannot !! be located, the routine returns NaN. real ( real64 ), intent ( out ), optional :: t1 !! An optional parameter that, if provided, allows for the routine to !! return the time at which the first peak was located. If sufficient !! peaks cannot be located, the routine returns NaN. real ( real64 ), intent ( out ), optional :: t2 !! An optional parameter that, if provided, allows for the routine to !! return the time at which the second peak was located. If sufficient !! peaks cannot be located, the routine returns NaN. real ( real64 ), intent ( in ), optional :: s !! An optional input that, if provided, allows for control of the !! sensitivity of the peak detection algorithm. The default is 0.1% !! of the peak-peak amplitude of the signal. integer ( int32 ), intent ( in ), optional :: n !! An optional input that, if provided, determines the number of !! periods to allow between peak selection for the logarithmic !! decrement calculation. The default is 1. ! Local Variables integer ( int32 ) :: np , i1 , i2 , j2 real ( real64 ) :: xmax , xmin , dx , x1p , x2p , t1p , t2p , nan integer ( int32 ), allocatable , dimension (:) :: maxind , minind real ( real64 ), allocatable , dimension (:) :: maxvals , minvals ! Determine a suitable sensitivity to peak detection if ( present ( s )) then dx = s else xmax = maxval ( x ) xmin = minval ( x ) dx = 1.0d-3 * ( xmax - xmin ) end if ! Peak Count if ( present ( n )) then np = n else np = 1 end if ! Additional initialization nan = ieee_value ( nan , IEEE_QUIET_NAN ) delta = nan fn = nan t1p = nan t2p = nan x1p = nan x2p = nan ! Locate peaks call peak_detect ( x , dx , maxind , maxvals , minind , minvals ) if ( size ( maxind ) < 2 ) then ! Return NaN's as we couldn't find enough peaks go to 10 end if i1 = maxind ( 1 ) np = min ( np , size ( maxind ) - 1 ) j2 = np + 1 i2 = maxind ( j2 ) t1p = t ( i1 ) t2p = t ( i2 ) x1p = x ( i1 ) x2p = x ( i2 ) delta = logarithmic_decrement ( x1p , x2p , np ) fn = np / ( t2p - t1p ) ! End 10 continue if ( present ( x1 )) x1 = x1p if ( present ( x2 )) x2 = x2p if ( present ( t1 )) t1 = t1p if ( present ( t2 )) t2 = t2p end subroutine ! ------------------------------------------------------------------------------ pure elemental function rise_time ( wn , zeta ) result ( rst ) !! Computes the rise time for an underdamped, second-order system. The !! rise time is the time it takes for the system response to go from 0% !! to 100% of its final value and is given by the following relationship. !! !! t_r = \\frac{1}{\\omega_d} \\left( \\pi - !! \\arctan \\frac{\\sqrt{1 - zeta^2}}{\\zeta} \\right) real ( real64 ), intent ( in ) :: wn !! The resonant frequency of the system, in rad/s. real ( real64 ), intent ( in ) :: zeta !! The damping ratio of the system. This value must be less than 1 !! as this relationship is only valid for an underdamped system. real ( real64 ) :: rst !! The rise time, in units of seconds. ! Local Variables real ( real64 ) :: arg ! Parameters real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) ! Process arg = sqrt ( 1.0d0 - zeta ** 2 ) rst = ( 1.0d0 / ( wn * arg )) * ( pi - atan ( arg / zeta )) end function ! ------------------------------------------------------------------------------ pure function find_settling_amplitude ( x ) result ( rst ) use fftpack , only : rfft !! Estimates the settling amplitude for a step response. real ( real64 ), intent ( in ), dimension (:) :: x !! The step response of the system. real ( real64 ) :: rst !! The settling amplitude of the step response. ! Local Variables real ( real64 ), allocatable , dimension (:) :: xfft ! Compute the FFT of X and normalize xfft = rfft ( x ) / size ( x ) ! We only need the DC component rst = xfft ( 1 ) end function ! ------------------------------------------------------------------------------ pure function damping_from_fractional_overshoot ( x ) result ( rst ) !! Employs the method of fractional overshoot to estimate the damping ratio !! from the response of a system to a step input. This method is useful !! for cases where the damping ratio is between approximately 0.5 to 0.8. !! In such range, the logarithmic decrement approach becomes less precise. !! !! The fractional overshoot method locates the amplitude of the first !! peak of oscillation (x_p) and the settling amplitude (x_f), and !! the estimates the damping ratio as follows. !! !! s = \\frac{x_p - x_f}{x_f} !! !! \\zeta = \\frac{1}{\\sqrt{1 + \\left( \\frac{\\pi}{\\ln{s}} \\right)^2}} real ( real64 ), intent ( in ), dimension (:) :: x !! The step response of the system. real ( real64 ) :: rst !! The estimated damping ratio. ! Parameters real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) ! Local Variables real ( real64 ) :: xp , xf , s ! Locate the amplitude terms xp = maxval ( abs ( x )) xf = abs ( find_settling_amplitude ( x )) s = ( xp - xf ) / xf ! Compute the damping ratio rst = 1.0d0 / sqrt ( 1.0d0 + ( pi / log ( s )) ** 2 ) end function ! ------------------------------------------------------------------------------ pure elemental function evaluate_step_response ( wn , zeta , xs , t ) result ( rst ) !! Evaluates the response of an underdamped single-degree-of-freedom, !! linear system to a step function of amplitude X_s. !! !! The step function response of an underdamped linear SDOF system is given !! as follows. !! !! \\ddot{x} + 2 \\zeta \\omega_n \\dot{x} + \\omega_n^2 x = \\frac{F(t)}{m} !! !! \\frac{x(t)}{X_s} = 1 - e^{-\\zeta \\omega_n t} \\left( !! \\frac{\\zeta \\omega_n}{\\omega_d} \\sin{\\omega_d t} + \\cos{\\omega_d t} !! \\right) !! !! where, !! !! \\omega_d = \\omega_n \\sqrt{1 - \\zeta^2} !! !! and !! !! X_s = \\frac{F}{k} real ( real64 ), intent ( in ) :: wn !! The resonant frequency, in rad/s. real ( real64 ), intent ( in ) :: zeta !! The damping ratio. real ( real64 ), intent ( in ) :: xs !! The amplitude of the step input. real ( real64 ), intent ( in ) :: t !! The point in time at which to evaluate the response (units = s). real ( real64 ) :: rst !! The step response. ! Local Variables real ( real64 ) :: wd , A ! Process wd = wn * sqrt ( 1.0d0 - zeta ** 2 ) A = zeta * wn / wd rst = xs * ( 1.0d0 - exp ( - zeta * wn * t ) * ( A * sin ( wd * t ) + cos ( wd * t ))) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_vibrations.f90.html"}]} \ No newline at end of file +var tipuesearch = {"pages":[{"title":" DYNAMICS ","text":"DYNAMICS Developer Info Jason Christopherson","tags":"home","loc":"index.html"},{"title":"state_space – DYNAMICS ","text":"type, public :: state_space Defines a state-space representation of a dynamic system. This\nimplementation takes the form: Where: denotes time. is the state vector. is the input vector. is the output vector. Contents Variables A B C D Constructor state_space Type-Bound Procedures evaluate_derivatives evaluate_output poles transfer_function zeros Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:,:) :: A The N-by-N dynamics matrix, where N is the number of state\nvariables. real(kind=real64), public, allocatable, dimension(:,:) :: B The N-by-M input matrix, where M is the number of inputs. real(kind=real64), public, allocatable, dimension(:,:) :: C The P-by-N output matrix, where P is the number of outputs. real(kind=real64), public, allocatable, dimension(:,:) :: D The P-by-M feedthrough matrix. Constructor public interface state_space private pure function state_space_init(m, b, k, n_out) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: m The N-by-N mass matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: b The N-by-N damping matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: k The N-by-N stiffness matrix. integer(kind=int32), intent(in), optional :: n_out The number of outputs. The default is 1. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_scalar(m, b, k) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: m The mass. real(kind=real64), intent(in) :: b The damping. real(kind=real64), intent(in) :: k The stiffness. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_matrices(a, b, c, d) result(rst) Initializes the state space model. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix. real(kind=real64), intent(in), dimension(:,:) :: b The N-by-M input matrix. real(kind=real64), intent(in), dimension(:,:) :: c The P-by-N output matrix. real(kind=real64), intent(in), dimension(:,:) :: d The P-by-M feedthrough matrix. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid(kp, ki, kd, tau, a, b, c, d) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix for the plant. real(kind=real64), intent(in), dimension(size(a, 1), 1) :: b The N-by-1 input matrix for the plant. real(kind=real64), intent(in), dimension(1, size(a, 1)) :: c The 1-by-N output matrix for the plant. real(kind=real64), intent(in), dimension(1, 1) :: d The 1-by-1 feedthrough matrix for the plant. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid_plant(kp, ki, kd, tau, plant) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . class( state_space ), intent(in) :: plant The plant model. Return Value type( state_space ) The resulting [[state_space]] object. Type-Bound Procedures procedure, public :: evaluate_derivatives => ss_eval_deriv private pure function ss_eval_deriv(this, u, x) result(rst) Evaluates the state time derivative . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in), dimension(:) :: u The M-element input array. real(kind=real64), intent(in), dimension(:) :: x The N-element state array. Return Value real(kind=real64), allocatable, dimension(:) The N-element state time derivative vector. procedure, public :: evaluate_output => ss_eval_output private pure function ss_eval_output(this, u, x) result(rst) Evaluates the output vector . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in), dimension(:) :: u The M-element input array. real(kind=real64), intent(in), dimension(:) :: x The N-element state array. Return Value real(kind=real64), allocatable, dimension(:) The P-element output array. procedure, public :: poles => ss_poles private function ss_poles(this, err) result(rst) Computes the poles of the state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The poles of the model. generic, public :: transfer_function => ss_transfer_fcn, ss_transfer_fcn_omega, ss_transfer_fcn_array, ss_transfer_fcn_omega_array private pure function ss_transfer_fcn(this, s) result(rst) Evaluates the transfer functions for the model at the parameter . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. complex(kind=real64), intent(in) :: s The frequency at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:) The resulting transfer functions. private pure function ss_transfer_fcn_omega(this, omega) result(rst) Evaluates the transfer functions for the model at frequency . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in) :: omega The frequency at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:) The resulting transfer functions. private pure function ss_transfer_fcn_array(this, s) result(rst) Evaluates the transfer functions for the model at the frequencies given\nin the array . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. complex(kind=real64), intent(in), dimension(:) :: s The frequencies at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:,:) The resulting transfer functions, with each page of the array \ncontaining the transfer functions for a specific frequency. private pure function ss_transfer_fcn_omega_array(this, omega) result(rst) Evaluates the transfer functions for the model at the frequencies given\nin the array . Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. real(kind=real64), intent(in), dimension(:) :: omega The frequencies at which to evaluate the transfer functions. Return Value complex(kind=real64), allocatable, dimension(:,:,:) The resulting transfer functions, with each page of the array \ncontaining the transfer functions for a specific frequency. procedure, public :: zeros => ss_zeros private function ss_zeros(this, err) result(rst) Computes the zeros of the state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in) :: this The state_space object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The zeros of the model.","tags":"","loc":"type\\state_space.html"},{"title":"transfer_function – DYNAMICS ","text":"type, public :: transfer_function Defines a transfer function for a continuous system of the form . Contents Variables X Y Constructor transfer_function Type-Bound Procedures evaluate poles to_ccf_state_space to_ocf_state_space zeros Components Type Visibility Attributes Name Initial type(polynomial), public :: X The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . type(polynomial), public :: Y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . Constructor public interface transfer_function private function init_tf_array(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . real(kind=real64), intent(in), dimension(:) :: x The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . Return Value type( transfer_function ) The resulting [[transfer_function]]. private function init_tf_poly(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: y The numerator polynomial in . class(polynomial), intent(in) :: x The denominator polynomial in . Return Value type( transfer_function ) The resulting [[transfer_function]]. Type-Bound Procedures generic, public :: evaluate => tf_eval_omega, tf_eval_s private pure elemental function tf_eval_omega(this, omega) result(rst) Evaluates the transfer function at the specified value of the . Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function object. real(kind=real64), intent(in) :: omega The frequency, in rad/s, at which to evaluate the transfer \nfunction. Return Value complex(kind=real64) The value of the transfer function. private pure elemental function tf_eval_s(this, s) result(rst) Evaluates the transfer function at the specified value of the\nLaplace variable . Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function object. complex(kind=real64), intent(in) :: s The Laplace variable at which to evaluate the transfer function. Return Value complex(kind=real64) The value of the transfer function. procedure, public :: poles => tf_poles private function tf_poles(this, err) result(rst) Computes the poles of the transfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The poles of the transfer function. procedure, public :: to_ccf_state_space => tf_to_ccf_statespace private function tf_to_ccf_statespace(this) result(rst) Converts a transfer_function type into a controllable canonical form\nstate_space type. See this article\nfor a description of this form. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function to convert. Return Value type( state_space ) The resulting state-space object. procedure, public :: to_ocf_state_space => tf_to_ocf_statespace private function tf_to_ocf_statespace(this) result(rst) Converts a transfer_function type into an observable canonical form\nstate_space type. See this article\nfor a description of this form. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer_function to convert. Return Value type( state_space ) The resulting state-space object. procedure, public :: zeros => tf_zeros private function tf_zeros(this, err) result(rst) Computes the zeros of the transfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: this The transfer function object. class(errors), intent(inout), optional, target :: err An error handling object. Return Value complex(kind=real64), allocatable, dimension(:) The zeros of the transfer function.","tags":"","loc":"type\\transfer_function.html"},{"title":"frf – DYNAMICS ","text":"type, public :: frf A container for a frequency response function, or series of frequency\nresponse functions. Contents Variables frequency responses Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:) :: responses An N-by-M matrix containing the M frequency response functions\nevaluated at each of the N frequency points.","tags":"","loc":"type\\frf.html"},{"title":"mimo_frf – DYNAMICS ","text":"type, public :: mimo_frf A container for the frequency responses of a system of multiple \ninputs and multiple outputs (MIMO). Contents Variables frequency responses Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:,:) :: responses An N-by-M-by-P array containing the frequency response functions\nfor each of the M outputs corresponding to each of the P inputs.","tags":"","loc":"type\\mimo_frf.html"},{"title":"line – DYNAMICS ","text":"type, public :: line Defines the parametric form of a line . Contents Variables r0 v Constructor line Type-Bound Procedures evaluate Components Type Visibility Attributes Name Initial real(kind=real64), public :: r0 (3) The coordinates of the initial point . real(kind=real64), public :: v (3) The vector defining the orientation of the line. Constructor public interface line private pure function line_from_2pts(pt1, pt2) result(rst) Constructs a line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. This point will act as the initial point\nalong the line such that in the\nequation of the line . real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( line ) The resulting line. private pure function line_from_2_planes(p1, p2) result(rst) Constructs a line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function line_from_many_points(pts) result(rst) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts An N-by-3 matrix where N is at least 2, but typically much\nlarger. Return Value type( line ) The resulting line. Type-Bound Procedures procedure, public :: evaluate => line_eval private pure function line_eval(this, t) result(rst) Evaluates the equation of the line at the specified parameter. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: this The line. real(kind=real64), intent(in) :: t The parameter. Return Value real(kind=real64), (3) The location along the line defined by the parameter .","tags":"","loc":"type\\line.html"},{"title":"plane – DYNAMICS ","text":"type, public :: plane Defines a plane as . Contents Variables a b c d Constructor plane Type-Bound Procedures flip_normal Components Type Visibility Attributes Name Initial real(kind=real64), public :: a The x-component of the plane normal vector. real(kind=real64), public :: b The y-component of the plane normal vector. real(kind=real64), public :: c The z-component of the plane normal vector. real(kind=real64), public :: d The offset from the origin. Constructor public interface plane private pure function plane_from_3pts(pt1, pt2, pt3) result(rst) Constructs a plane from 3 points. The 3 points must not be colinear. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. real(kind=real64), intent(in) :: pt3 (3) The third point. Return Value type( plane ) The resulting plane. private pure function plane_from_point_and_normal(pt, nrm) result(rst) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point that lies on the plane. real(kind=real64), intent(in) :: nrm (3) The normal unit vector. Return Value type( plane ) The resulting plane. private pure function plane_from_many_points(pts) result(rst) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts The N-by-3 matrix containing the N points to fit. N must be\nat least 3, but is typically much larger. Return Value type( plane ) The resulting plane. Type-Bound Procedures procedure, public :: flip_normal => plane_flip_normal private subroutine plane_flip_normal(this) Flips the normal vector of the plane. Arguments Type Intent Optional Attributes Name class( plane ), intent(inout) :: this The plane.","tags":"","loc":"type\\plane.html"},{"title":"plucker_line – DYNAMICS ","text":"type, public :: plucker_line Defines a line in 3D Euclidean space using Plücker coordinates. Contents Variables v Constructor plucker_line Type-Bound Procedures m to_array u Components Type Visibility Attributes Name Initial real(kind=real64), public :: v (6) The 6-element array containing the Plücker coordinates. The\nfirst 3 elements contain the unit vector and the last 3 elements\ncontain the moment vector. Constructor public interface plucker_line private pure function pl_from_2pts(pt1, pt2) result(rst) Constructs a new plucker_line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( plucker_line ) The resulting line. private pure function pl_from_line(ln) result(rst) Constructs a new plucker_line from a line object. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln The line. Return Value type( plucker_line ) The equivalent plucker_line. private pure function pl_from_2_planes(p1, p2) result(rst) Constructs a new plucker_line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( plucker_line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function pl_from_array(x, nrm) result(rst) Constructs a new plucker_line from the supplied array. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (6) A 6-element array containing the Plücker coordinates. logical, intent(in), optional :: nrm An optional input that specifies if the first three coordinates\n(the unit vector) should be normalized (true), or left as-is\n(false). The default is true such that the vector is normalized. Return Value type( plucker_line ) The resulting line. Type-Bound Procedures procedure, public :: m => pl_m private pure function pl_m(this) result(rst) The line moment vector. Arguments Type Intent Optional Attributes Name class( plucker_line ), intent(in) :: this The plucker_line object. Return Value real(kind=real64), (3) The moment vector. procedure, public :: to_array => pl_to_array private pure function pl_to_array(this) result(rst) Returns the plucker_line as a 6-element array of the form [u, m]. Arguments Type Intent Optional Attributes Name class( plucker_line ), intent(in) :: this The plucker_line object. Return Value real(kind=real64), (6) The resulting array. procedure, public :: u => pl_u private pure function pl_u(this) result(rst) The unit vector representing the orientation of the line. Arguments Type Intent Optional Attributes Name class( plucker_line ), intent(in) :: this The plucker_line object. Return Value real(kind=real64), (3) The unit vector.","tags":"","loc":"type\\plucker_line.html"},{"title":"coordinate_system – DYNAMICS ","text":"type, public :: coordinate_system Defines a 3D Cartesian coordinate system. Contents Variables i j k origin Constructor coordinate_system Components Type Visibility Attributes Name Initial real(kind=real64), public :: i (3) The unit vector along the coordinate system's x-axis. real(kind=real64), public :: j (3) The unit vector along the coordinate system's y-axis. real(kind=real64), public :: k (3) The unit vector along the coordinate system's z-axis. real(kind=real64), public :: origin (3) The location of the origin of the coordinate system in the parent\ncoordinate system. Constructor public interface coordinate_system private pure function define_link_csys(xim1, zim1, zi, rim1, ri) result(rst) Defines the DH coordinate system for the specified link. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: xim1 (3) The x-axis of the previous link. real(kind=real64), intent(in) :: zim1 (3) The z-axis of the previous link. This is also the axis of the\nproximal joint of the current link. real(kind=real64), intent(in) :: zi (3) The axis of the distal joint of the current link. real(kind=real64), intent(in) :: rim1 (3) The location of the proximal joint's center or home position. real(kind=real64), intent(in) :: ri (3) The location of the distal joint's center or home position. Return Value type( coordinate_system ) The resulting coordinate system. private pure function define_csys(i, j, k, o) result(rst) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The x-axis unit vector. real(kind=real64), intent(in) :: j (3) The y-axis unit vector. real(kind=real64), intent(in) :: k (3) The x-axis unit vector. real(kind=real64), intent(in), optional :: o (3) The location of the coordinate system within a reference \ncoordinate system. If not supplied, a value of (0, 0, 0) will\nbe used. Return Value type( coordinate_system ) The new coordinate_system object.","tags":"","loc":"type\\coordinate_system.html"},{"title":"dh_parameter_set – DYNAMICS ","text":"type, public :: dh_parameter_set Describes a set of Denavit-Hartenberg parameters for a single joint. Contents Variables joint_angle link_length link_offset link_twist Constructor dh_parameter_set Components Type Visibility Attributes Name Initial real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. Constructor public interface dh_parameter_set private pure function dps_init(length, twist, offset, angle) result(rst) Constructs a new dh_parameter_set object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: length The link length. real(kind=real64), intent(in) :: twist The link twist. real(kind=real64), intent(in) :: offset The link offset. real(kind=real64), intent(in) :: angle The joint angle. Return Value type( dh_parameter_set ) The new dh_parameter_set object.","tags":"","loc":"type\\dh_parameter_set.html"},{"title":"dh_table – DYNAMICS ","text":"type, public :: dh_table Describes a Denavit-Hartenberg table. Contents Variables parameters Constructor dh_table Components Type Visibility Attributes Name Initial type( dh_parameter_set ), public, allocatable, dimension(:) :: parameters A collection of DH parameters for each joint in the linkage. Constructor public interface dh_table private pure function dh_table_init(c) result(rst) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Arguments Type Intent Optional Attributes Name class( coordinate_system ), intent(in), dimension(:) :: c An N-element array containing the coordinate frames for each\nof the N links of the linkage. Return Value type( dh_table ) The resulting Denavit-Hartenberg table.","tags":"","loc":"type\\dh_table.html"},{"title":"binary_link – DYNAMICS ","text":"type, public, extends( rigid_body ) :: binary_link Defines a link consisting of only two joints. The coordinate system\nof this link is situated at the distal joint with it's z-axis \ncoincident with the axis of the joint. The link utilizes a\nDenavit-Hartenberg convention in order to express its geometry. Contents Variables cg inertia joint_angle joint_type link_length link_offset link_twist mass Constructor binary_link Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: joint_type The proximal joint type. This value must be either \nREVOLUTE_JOINT or PRISMATIC_JOINT. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the fixed distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. real(kind=real64), public :: mass The mass of the body. Constructor public interface binary_link private pure function bl_init(jtype, length, twist, offset, angle, mass, inertia, cg) result(rst) Initializes a new parallel_revolute_revolute_link instance. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in), optional :: jtype The proximal joint type. This value must be either &\nREVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, \nthis parameter defaults to REVOLUTE_JOINT. real(kind=real64), intent(in), optional :: length The link length. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: twist The link twist angle. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: offset The link offset. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: angle The joint angle offset. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: mass The mass of the link. If no value is specified, a value of 1 is\nused. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not specified, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the distal coordinate\nframe, expressed in the link coordinate frame. If not supplied,\nthe CG is set to (0, 0, 0) such that it is located at the center\nof the distal joint. Return Value type( binary_link ) The resulting binary_link object.","tags":"","loc":"type\\binary_link.html"},{"title":"serial_linkage – DYNAMICS ","text":"type, public :: serial_linkage Defines a serial linkage. Contents Constructor serial_linkage Type-Bound Procedures forward_kinematics get_link get_link_count inverse_kinematics jacobian Constructor public interface serial_linkage private function sl_init(lnks) result(rst) Initializes a new serial_linkage object. Arguments Type Intent Optional Attributes Name class( binary_link ), intent(in), dimension(:) :: lnks A collection of binary_link objects. The collection starts with\nthe first link and progresses to the end-effector in a \nsequential manner. Return Value type( serial_linkage ) The serial_linkage instance. Type-Bound Procedures procedure, public :: forward_kinematics => sl_forward_kinematics private function sl_forward_kinematics(this, q, err) result(rst) Computes the forward kinematics for the linkage resulting in a \ntransformation matrix between world and end-effector coordinate\nframes. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. real(kind=real64), intent(in), dimension(:) :: q The array of joint variables. This array must be the same size\nas there are number of links in this linkage. class(errors), intent(inout), optional, target :: err An errors-based object providing error handling in the event the\narray size is incorrect. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. procedure, public :: get_link => sl_get_link private function sl_get_link(this, i) result(rst) Gets a pointer to the requested link object. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. integer(kind=int32), intent(in) :: i The index of the link to retrieve (1 = first link). Return Value class( binary_link ), pointer A pointer to the requested link. procedure, public :: get_link_count => sl_get_link_count private pure function sl_get_link_count(this) result(rst) Gets the number of links in the linkage. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. Return Value integer(kind=int32) The link count. procedure, public :: inverse_kinematics => sl_inverse_kinematics_1 private function sl_inverse_kinematics_1(this, qo, trg, ib, err) result(rst) Solves the inverse kinematics problem for the linkage. Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in), target :: this The serial_linkage object. real(kind=real64), intent(in), dimension(:) :: qo An M-element array containing an initial estimate of the M joint\nvariables. real(kind=real64), intent(in) :: trg (4,4) A transformation matrix relating the end-effector coordinate\nframe and the world coordinate frame. This transformation \nmatrix defines the end-effector target for the solver. type(iteration_behavior), intent(out), optional :: ib An optional output that can be used to gather information on the\nsolver. class(errors), intent(inout), optional, target :: err An optional error handling object used to retrieve any errors\nregarding the solver. Return Value real(kind=real64), allocatable, dimension(:) An M-element array containing the computed joint variables that\nsatisfy the constraints. procedure, public :: jacobian => sl_jacobian private function sl_jacobian(this, q, err) result(rst) Constructs the Jacobian matrix for the linkage. The Jacobian matrix \nrelates the joint velocities to the end-effector \nvelocity by . Arguments Type Intent Optional Attributes Name class( serial_linkage ), intent(in) :: this The serial_linkage object. real(kind=real64), intent(in), dimension(:) :: q The array of joint variables. This array must be the same size\nas there are number of links in this linkage. class(errors), intent(inout), optional, target :: err An errors-based object providing error handling in the event the\narray size is incorrect. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-N Jacobian matrix where N is the number of\nlinks in the linkage.","tags":"","loc":"type\\serial_linkage.html"},{"title":"quaternion – DYNAMICS ","text":"type, public :: quaternion Defines a quaternion of the form: Contents Variables w x y z Constructor quaternion Type-Bound Procedures normalize to_angle_axis to_array to_matrix to_roll_pitch_yaw Components Type Visibility Attributes Name Initial real(kind=real64), public :: w The real component of the quaternion. real(kind=real64), public :: x The first element in the imaginary component of the quaternion. real(kind=real64), public :: y The second element in the imaginary component of the quaternion. real(kind=real64), public :: z The third element in the imaginary component of the quaternion. Constructor public interface quaternion private pure function quat_init_array(x) result(rst) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(4) :: x The array from which to initialize the quaternion stored in the\norder [w, x, y, z]. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_angle_axis(angle, axis) result(rst) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. real(kind=real64), intent(in), dimension(3) :: axis A 3-element vector defining the axis about which the rotation\noccurrs. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_mtx(r) result(rst) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(3, 3) :: r The rotation matrix. Return Value type( quaternion ) The resulting quaternion. Type-Bound Procedures procedure, public :: normalize => quat_normalize private pure subroutine quat_normalize(q) Normalizes the quaternion. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(inout) :: q On input, the quaternion to normalize. On output, the normalized\nquaternion. procedure, public :: to_angle_axis => quat_to_angle_axis private pure subroutine quat_to_angle_axis(q, angle, axis) Converts the quaternion to the equivalent angle-axis form. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. real(kind=real64), intent(out) :: angle The rotation angle, in radians. real(kind=real64), intent(out) :: axis (3) The axis of rotation. procedure, public :: to_array => quat_to_vec4 private pure function quat_to_vec4(q) result(rst) Converts a quaternion to a 4-element array of the form [w, x, y, z]. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(4) The array of the form [w, x, y, z]. procedure, public :: to_matrix => quat_to_matrix private pure function quat_to_matrix(q) result(rst) Converts the quaternion to a 3-by-3 rotation matrix. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(3,3) The resulting rotation matrix. procedure, public :: to_roll_pitch_yaw => quat_to_rpy private pure subroutine quat_to_rpy(q, roll, pitch, yaw) Converts the quaternion to the equivalent Euler angles of roll, \npitch, and yaw. Arguments Type Intent Optional Attributes Name class( quaternion ), intent(in) :: q The quaternion. real(kind=real64), intent(out) :: roll The roll angle (rotation about the body x-axis), in radians. real(kind=real64), intent(out) :: pitch The pitch angle (rotation about the body y-axis), in radians. real(kind=real64), intent(out) :: yaw The yaw angle (rotation about the body z-axis), in radians.","tags":"","loc":"type\\quaternion.html"},{"title":"rigid_body – DYNAMICS ","text":"type, public :: rigid_body Defines a rigid body. Contents Variables cg inertia mass Constructor rigid_body Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: mass The mass of the body. Constructor public interface rigid_body private pure function rb_init(m, inertia, cg) result(rst) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Return Value type( rigid_body ) The rigid_body object.","tags":"","loc":"type\\rigid_body.html"},{"title":"beam_element_2d – DYNAMICS ","text":"type, public, extends( line_element ) :: beam_element_2d Defines a two-dimensional Bernoulli-Euler beam element. Contents Variables area material moment_of_inertia node_1 node_2 Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count get_terminal_nodes jacobian length mass_matrix rotation_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. real(kind=real64), public :: moment_of_inertia The beam moment of inertia (second moment of area). type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). Type-Bound Procedures procedure, public :: constitutive_matrix => b2d_constitutive_matrix private pure function b2d_constitutive_matrix(this) result(rst) Computes the constitutive matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: evaluate_shape_function => b2d_shape_function private pure function b2d_shape_function(this, i, s) result(rst) Evaluates the i-th shape function at natural coordinate s. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => le_ext_force_vector private pure function le_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure, public :: get_dimensionality => b2d_dimensionality private pure function b2d_dimensionality(this) result(rst) Gets the dimensionality of the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value integer(kind=int32) The dimensionality. procedure, public :: get_dof_per_node => b2d_dof_per_node private pure function b2d_dof_per_node(this) result(rst) Gets the number of degrees of freedom per node. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value integer(kind=int32) The number of DOF per node. procedure, public :: get_node => b2d_get_node private pure function b2d_get_node(this, i) result(rst) Gets the requested node from the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The requested node. procedure, public :: get_node_count => b2d_get_node_count private pure function b2d_get_node_count(this) result(rst) Gets the number of nodes for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value integer(kind=int32) The number of nodes. procedure, public :: get_terminal_nodes => b2d_terminal_nodes private pure subroutine b2d_terminal_nodes(this, i1, i2) Gets the terminal node numbers for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(out) :: i1 The index of the node at the head of the element. integer(kind=int32), intent(out) :: i2 The index of the node at the tail of the element. procedure, public :: jacobian => b2d_jacobian private pure function b2d_jacobian(this, s) result(rst) Computes the Jacobian matrix for a 2D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The Jacobian matrix. procedure, public :: length => le_length private pure function le_length(this) result(rst) Computes the length of the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64) The length of the line element. procedure, public :: mass_matrix => b2d_mass_matrix private pure function b2d_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: rotation_matrix => b2d_rotation_matrix private pure function b2d_rotation_matrix(this) result(rst) Computes the rotation matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-6 rotation matrix. procedure, public :: shape_function_matrix => b2d_shape_function_matrix_2d private pure function b2d_shape_function_matrix_2d(this, s) result(rst) Computes the shape function matrix for a beam element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the shape\nfunctions. Return Value real(kind=real64), allocatable, dimension(:,:) The shape function matrix. procedure, public :: stiffness_matrix => b2d_stiffness_matrix private pure function b2d_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: strain_displacement_matrix => b2d_strain_disp_matrix_2d private pure function b2d_strain_disp_matrix_2d(this, s) result(rst) Computes the strain-displacement matrix for a 2D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_2d ), intent(in) :: this The beam_element_2d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The strain-displacement matrix.","tags":"","loc":"type\\beam_element_2d.html"},{"title":"beam_element_3d – DYNAMICS ","text":"type, public, extends( line_element ) :: beam_element_3d Defines a three-dimensional Bernoulli-Euler beam element. Contents Variables Ixx Iyy Izz area material node_1 node_2 orientation_point Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count get_terminal_nodes jacobian length mass_matrix rotation_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial real(kind=real64), public :: Ixx The beam moment of inertia about the element x-axis. real(kind=real64), public :: Iyy The beam moment of inertia about the element y-axis. real(kind=real64), public :: Izz The beam moment of inertia about the element z-axis. real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). type( point ), public :: orientation_point A point used to determine the orientation of the beam in 3D\nspace. The orientation point is measured relative to the first\nnode in the element. Specifically, the element z axis is assumed\nto be defined by the location of this point relative to the\nlocation of node 1. Type-Bound Procedures procedure, public :: constitutive_matrix => b3d_constitutive_matrix private pure function b3d_constitutive_matrix(this) result(rst) Computes the constitutive matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: evaluate_shape_function => b3d_shape_function private pure function b3d_shape_function(this, i, s) result(rst) Evaluates the i-th shape function at natural coordinate s. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => le_ext_force_vector private pure function le_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure, public :: get_dimensionality => b3d_dimensionality private pure function b3d_dimensionality(this) result(rst) Gets the dimensionality of the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value integer(kind=int32) The dimensionality. procedure, public :: get_dof_per_node => b3d_dof_per_node private pure function b3d_dof_per_node(this) result(rst) Gets the number of degrees of freedom per node. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value integer(kind=int32) The number of DOF per node. procedure, public :: get_node => b3d_get_node private pure function b3d_get_node(this, i) result(rst) Gets the requested node from the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The requested node. procedure, public :: get_node_count => b3d_get_node_count private pure function b3d_get_node_count(this) result(rst) Gets the number of nodes for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value integer(kind=int32) The number of nodes. procedure, public :: get_terminal_nodes => b3d_terminal_nodes private pure subroutine b3d_terminal_nodes(this, i1, i2) Gets the terminal node numbers for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(out) :: i1 The index of the node at the head of the element. integer(kind=int32), intent(out) :: i2 The index of the node at the tail of the element. procedure, public :: jacobian => b3d_jacobian private pure function b3d_jacobian(this, s) result(rst) Computes the Jacobian matrix for a 3D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The Jacobian matrix. procedure, public :: length => le_length private pure function le_length(this) result(rst) Computes the length of the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64) The length of the line element. procedure, public :: mass_matrix => b3d_mass_matrix private pure function b3d_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: rotation_matrix => b3d_rotation_matrix private pure function b3d_rotation_matrix(this) result(rst) Computes the rotation matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 12-by-12 rotation matrix. procedure, public :: shape_function_matrix => b3d_shape_function_matrix_3d private pure function b3d_shape_function_matrix_3d(this, s) result(rst) Computes the shape function matrix for a beam element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the shape\nfunctions. Return Value real(kind=real64), allocatable, dimension(:,:) The shape function matrix. procedure, public :: stiffness_matrix => b3d_stiffness_matrix private pure function b3d_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: strain_displacement_matrix => b3d_strain_disp_matrix_3d private pure function b3d_strain_disp_matrix_3d(this, s) result(rst) Computes the strain-displacement matrix for a 3D beam element. Arguments Type Intent Optional Attributes Name class( beam_element_3d ), intent(in) :: this The beam_element_3d object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinate at which to evaluate the matrix. Return Value real(kind=real64), allocatable, dimension(:,:) The strain-displacement matrix.","tags":"","loc":"type\\beam_element_3d.html"},{"title":"element – DYNAMICS ","text":"type, public, abstract :: element Defines an element. Contents Variables material Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count jacobian mass_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial type( material ), public :: material The material. Type-Bound Procedures procedure(element_const_matrix_function), public, deferred, pass :: constitutive_matrix pure function element_const_matrix_function(this) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_shape_function), public, deferred, pass :: evaluate_shape_function pure function element_shape_function(this, i, s) result(rst) Prototype Defines the signature of a routine for computing the value of\nthe i-th element shape function at natural coordinate. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => e_ext_force_vector private pure function e_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure(element_query), public, deferred, pass :: get_dimensionality pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_query), public, deferred, pass :: get_dof_per_node pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_get_node), public, deferred, pass :: get_node pure function element_get_node(this, i) result(rst) Prototype Defines the signature of a function for retrieving the requested\nnode from the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The node. procedure(element_query), public, deferred, pass :: get_node_count pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_matrix_function), public, deferred, pass :: jacobian pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: mass_matrix => e_mass_matrix private pure function e_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: shape_function_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: stiffness_matrix => e_stiffness_matrix private pure function e_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: strain_displacement_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix.","tags":"","loc":"type\\element.html"},{"title":"line_element – DYNAMICS ","text":"type, public, abstract, extends( element ) :: line_element Defines a line element type. Contents Variables area material Type-Bound Procedures constitutive_matrix evaluate_shape_function external_force_vector get_dimensionality get_dof_per_node get_node get_node_count get_terminal_nodes jacobian length mass_matrix rotation_matrix shape_function_matrix stiffness_matrix strain_displacement_matrix Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. Type-Bound Procedures procedure(element_const_matrix_function), public, deferred, pass :: constitutive_matrix pure function element_const_matrix_function(this) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_shape_function), public, deferred, pass :: evaluate_shape_function pure function element_shape_function(this, i, s) result(rst) Prototype Defines the signature of a routine for computing the value of\nthe i-th element shape function at natural coordinate. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The index of the shape function to evaluate. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which to evaluate\nthe shape function. Return Value real(kind=real64) The value of the i-th shape function at s. procedure, public :: external_force_vector => le_ext_force_vector private pure function le_ext_force_vector(this, q, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. real(kind=real64), intent(in), dimension(:) :: q The surface traction forces vector or body force vector. For instance, a 2D problem this vector would look like [qx, qy]**T. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: DYN_ONE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_FOUR_POINT_INTEGRATION_RULE The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:) The resulting vector. procedure(element_query), public, deferred, pass :: get_dimensionality pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_query), public, deferred, pass :: get_dof_per_node pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(element_get_node), public, deferred, pass :: get_node pure function element_get_node(this, i) result(rst) Prototype Defines the signature of a function for retrieving the requested\nnode from the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. integer(kind=int32), intent(in) :: i The local index of the node to retrieve. Return Value type( node ) The node. procedure(element_query), public, deferred, pass :: get_node_count pure function element_query(this) result(rst) Prototype Defines the signature of a function performing a query on an\ninteger-valued property of a element type. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. Return Value integer(kind=int32) The resulting value. procedure(line_element_get_terminal), public, deferred, pass :: get_terminal_nodes pure subroutine line_element_get_terminal(this, i1, i2) Prototype Defines the signature of a routine for returning the terminal\nnode numbers. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. integer(kind=int32), intent(out) :: i1 The index of the node at the head of the element. integer(kind=int32), intent(out) :: i2 The index of the node at the tail of the element. procedure(element_matrix_function), public, deferred, pass :: jacobian pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: length => le_length private pure function le_length(this) result(rst) Computes the length of the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64) The length of the line element. procedure, public :: mass_matrix => le_mass_matrix private pure function le_mass_matrix(this, rule) result(rst) Computes the mass matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(line_element_const_matrix_function), public, deferred, pass :: rotation_matrix pure function line_element_const_matrix_function(this) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the line_element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: shape_function_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure, public :: stiffness_matrix => le_stiffness_matrix private pure function le_stiffness_matrix(this, rule) result(rst) Computes the stiffness matrix for the element. Arguments Type Intent Optional Attributes Name class( line_element ), intent(in) :: this The line_element object. integer(kind=int32), intent(in), optional :: rule The integration rule. The rule must be one of the following: MECH_ONE_POINT_INTEGRATION_RULE MECH_TWO_POINT_INTEGRATION_RULE MECH_THREE_POINT_INTEGRATION_RULE MECH_FOUR_POINT_INTEGRATION_RULE The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. procedure(element_matrix_function), public, deferred, pass :: strain_displacement_matrix pure function element_matrix_function(this, s) result(rst) Prototype Defines the signature of a routine for returning a matrix\nassociated with the element. Arguments Type Intent Optional Attributes Name class( element ), intent(in) :: this The element object. real(kind=real64), intent(in), dimension(:) :: s The value of the natural coordinates at which the matrix\nshould be evaluated. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix.","tags":"","loc":"type\\line_element.html"},{"title":"material – DYNAMICS ","text":"type, public :: material Defines a linear-elastic-isotropic material. Contents Variables density modulus poissons_ratio Components Type Visibility Attributes Name Initial real(kind=real64), public :: density The density of the material. real(kind=real64), public :: modulus The modulus of elasticity of the material. real(kind=real64), public :: poissons_ratio The Poisson's ratio of the material.","tags":"","loc":"type\\material.html"},{"title":"node – DYNAMICS ","text":"type, public, extends( point ) :: node Defines a node. Contents Variables dof index x y z Components Type Visibility Attributes Name Initial integer(kind=int32), public :: dof The number of degrees of freeedom associated with this node. integer(kind=int32), public :: index The global index of the node. real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate.","tags":"","loc":"type\\node.html"},{"title":"point – DYNAMICS ","text":"type, public :: point Defines a point in 3D, Cartesian space. Contents Variables x y z Components Type Visibility Attributes Name Initial real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate.","tags":"","loc":"type\\point.html"},{"title":"dynamic_system_measurement – DYNAMICS ","text":"type, public :: dynamic_system_measurement A container of a single measurement data set. Contents Variables input output t Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: input The input data. real(kind=real64), public, allocatable, dimension(:) :: output The output data. real(kind=real64), public, allocatable, dimension(:) :: t The time points at which the measurements were taken.","tags":"","loc":"type\\dynamic_system_measurement.html"},{"title":"model_information – DYNAMICS ","text":"type, public :: model_information A container for model information. Contents Variables excitation model user_info Components Type Visibility Attributes Name Initial class(base_interpolator), public, pointer :: excitation An interpolation object allowing sampling of the excitation \nfunction. real(kind=real64), public, allocatable, dimension(:) :: model An array containing the model parameters. class(*), public, pointer :: user_info Information the user has passed along.","tags":"","loc":"type\\model_information.html"},{"title":"lti_solve – DYNAMICS","text":"public function lti_solve(mdl, u, t, ic, solver, args, err) result(rst) Solves the LTI system given by the specified state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in), target :: mdl The state_space model to solve. procedure( ss_excitation ), intent(in), pointer :: u The routine used to compute the excitation vector. real(kind=real64), intent(in), dimension(:) :: t The time points at which to compute the solution. The array must\nhave at least 2 values; however, more may be specified. If only\n2 values are specified, the integrator will compute the solution at\nthose points, but it will also return any intermediate integration\nsteps that may be required. However, if more than 2 points are\ngiven, the integrator will return the solution values only at the\nspecified time points. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector. This array must be the same size as\nthe number of state variables. class(ode_integrator), intent(in), optional, target :: solver The ODE solver to utilize. If not specified, the default solver\nis a 4th/5th order Runge-Kutta integrator. class(*), intent(inout), optional :: args An optional container for arguments to pass to the excitation\nroutine. class(errors), intent(inout), optional, target :: err An error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The solution. The time points at which the solution was evaluated\nare stored in the first column and the output(s) are stored in the\nremaining column(s). Contents","tags":"","loc":"proc\\lti_solve.html"},{"title":"operator(*) – DYNAMICS","text":"public interface operator(*) Contents Module Procedures tf_tf_mult poly_tf_mult tf_poly_mult tf_scalar_mult scalar_tf_mult Module Procedures private function tf_tf_mult(x, y) result(rst) Multiplies two transfer functions. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function poly_tf_mult(x, y) result(rst) Multiplies a polynomial and a transfer function to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_poly_mult(x, y) result(rst) Multiplies a transfer function and a polynomial to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class(polynomial), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_scalar_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. real(kind=real64), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function scalar_tf_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function.","tags":"","loc":"interface\\operator(ASTERISK).html"},{"title":"ss_excitation – DYNAMICS","text":"interface public subroutine ss_excitation(t, u, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The time value at which to compute the excitation. real(kind=real64), intent(out), dimension(:) :: u The excitation vector. class(*), intent(inout), optional :: args An optional argument used to pass objects in and out of the\nroutine. Description A routine for computing the excitation vector for a state-space\nmodel.","tags":"","loc":"interface\\ss_excitation.html"},{"title":"state_space – DYNAMICS","text":"public interface state_space Contents Module Procedures state_space_init state_space_init_scalar state_space_init_matrices state_space_init_pid state_space_init_pid_plant Module Procedures private pure function state_space_init(m, b, k, n_out) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: m The N-by-N mass matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: b The N-by-N damping matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: k The N-by-N stiffness matrix. integer(kind=int32), intent(in), optional :: n_out The number of outputs. The default is 1. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_scalar(m, b, k) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: m The mass. real(kind=real64), intent(in) :: b The damping. real(kind=real64), intent(in) :: k The stiffness. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_matrices(a, b, c, d) result(rst) Initializes the state space model. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix. real(kind=real64), intent(in), dimension(:,:) :: b The N-by-M input matrix. real(kind=real64), intent(in), dimension(:,:) :: c The P-by-N output matrix. real(kind=real64), intent(in), dimension(:,:) :: d The P-by-M feedthrough matrix. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid(kp, ki, kd, tau, a, b, c, d) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix for the plant. real(kind=real64), intent(in), dimension(size(a, 1), 1) :: b The N-by-1 input matrix for the plant. real(kind=real64), intent(in), dimension(1, size(a, 1)) :: c The 1-by-N output matrix for the plant. real(kind=real64), intent(in), dimension(1, 1) :: d The 1-by-1 feedthrough matrix for the plant. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid_plant(kp, ki, kd, tau, plant) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . class( state_space ), intent(in) :: plant The plant model. Return Value type( state_space ) The resulting [[state_space]] object.","tags":"","loc":"interface\\state_space.html"},{"title":"transfer_function – DYNAMICS","text":"public interface transfer_function Contents Module Procedures init_tf_array init_tf_poly Module Procedures private function init_tf_array(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . real(kind=real64), intent(in), dimension(:) :: x The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . Return Value type( transfer_function ) The resulting [[transfer_function]]. private function init_tf_poly(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: y The numerator polynomial in . class(polynomial), intent(in) :: x The denominator polynomial in . Return Value type( transfer_function ) The resulting [[transfer_function]].","tags":"","loc":"interface\\transfer_function.html"},{"title":"report_array_index_out_of_bounds_error – DYNAMICS","text":"public subroutine report_array_index_out_of_bounds_error(name, var, ind, sz, err) Reports an array index-out-of-bounds error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The offending index. integer(kind=int32), intent(in) :: sz The array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_array_index_out_of_bounds_error.html"},{"title":"report_array_size_error – DYNAMICS","text":"public subroutine report_array_size_error(name, var, expected, actual, err) Reports an array size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expected The expected array size. integer(kind=int32), intent(in) :: actual The actual array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_array_size_error.html"},{"title":"report_constraint_count_error – DYNAMICS","text":"public subroutine report_constraint_count_error(name, expected, actual, err) Reports an error associated with an incorrect number of constraints. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: expected The expected number of constraints. integer(kind=int32), intent(in) :: actual The actual number of constraints. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_constraint_count_error.html"},{"title":"report_convergence_error – DYNAMICS","text":"public subroutine report_convergence_error(name, niter, resid, err) Reports a convergence error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: niter The actual number of iterations taken. real(kind=real64), intent(in) :: resid The current residual estimate. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=512), public :: errmsg","tags":"","loc":"proc\\report_convergence_error.html"},{"title":"report_generic_counting_error – DYNAMICS","text":"public subroutine report_generic_counting_error(name, str1, val, str2, flag, err) A generic error reporting routine. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: str1 The first string. integer(kind=int32), intent(in) :: val The integer value. character(len=*), intent(in) :: str2 The second string. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=512), public :: errmsg","tags":"","loc":"proc\\report_generic_counting_error.html"},{"title":"report_matrix_size_error – DYNAMICS","text":"public subroutine report_matrix_size_error(name, var, expect_rows, expect_cols, actual_rows, actual_cols, err) Reports a matrix size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expect_rows The expected number of rows. integer(kind=int32), intent(in) :: expect_cols The expected number of columns. integer(kind=int32), intent(in) :: actual_rows The actual number of rows. integer(kind=int32), intent(in) :: actual_cols The actual number of columns. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=512), public :: errmsg","tags":"","loc":"proc\\report_matrix_size_error.html"},{"title":"report_matrix_size_mismatch_error – DYNAMICS","text":"public subroutine report_matrix_size_mismatch_error(name, mtx1, mtx2, m1, n1, m2, n2, err) Reports a mismatch in matrix sizes. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: mtx1 The name of the first matrix. character(len=*), intent(in) :: mtx2 The name of the second matrix. integer(kind=int32), intent(in) :: m1 The number of rows in the first matrix. integer(kind=int32), intent(in) :: n1 The number of columns in the first matrix. integer(kind=int32), intent(in) :: m2 The number of rows in the second matrix. integer(kind=int32), intent(in) :: n2 The number of columns in the second matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_matrix_size_mismatch_error.html"},{"title":"report_memory_error – DYNAMICS","text":"public subroutine report_memory_error(name, flag, err) Reports a memory allocation error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: flag The flag returned from the allocate statement. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_memory_error.html"},{"title":"report_nonmonotonic_array_error – DYNAMICS","text":"public subroutine report_nonmonotonic_array_error(name, var, ind, err) Reports a nonmonotonic array error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The index of the occurrence of nonmonotonicity. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonmonotonic_array_error.html"},{"title":"report_nonsquare_mass_matrix_error – DYNAMICS","text":"public subroutine report_nonsquare_mass_matrix_error(name, m, n, err) Reports an error relating to a non-square mass matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the mass matrix. integer(kind=int32), intent(in) :: n The number of columns found in the mass matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonsquare_mass_matrix_error.html"},{"title":"report_nonsquare_matrix_error – DYNAMICS","text":"public subroutine report_nonsquare_matrix_error(name, var, m, n, err) Reports an error relating to a non-square matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: m The number of rows found in the matrix. integer(kind=int32), intent(in) :: n The number of columns found in the matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonsquare_matrix_error.html"},{"title":"report_nonsquare_stiffness_matrix_error – DYNAMICS","text":"public subroutine report_nonsquare_stiffness_matrix_error(name, m, n, err) Reports an error relating to a non-square stiffness matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the stiffness matrix. integer(kind=int32), intent(in) :: n The number of columns found in the stiffness matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_nonsquare_stiffness_matrix_error.html"},{"title":"report_null_forcing_routine_error – DYNAMICS","text":"public subroutine report_null_forcing_routine_error(name, err) Reports a null forcing routine pointer error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents","tags":"","loc":"proc\\report_null_forcing_routine_error.html"},{"title":"report_null_solver_routine_error – DYNAMICS","text":"public subroutine report_null_solver_routine_error(name, err) Reports a null solver routine error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents","tags":"","loc":"proc\\report_null_solver_routine_error.html"},{"title":"report_overconstraint_error – DYNAMICS","text":"public subroutine report_overconstraint_error(name, err) Reports an overconstraint error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents","tags":"","loc":"proc\\report_overconstraint_error.html"},{"title":"report_zero_difference_error – DYNAMICS","text":"public subroutine report_zero_difference_error(name, var1, val1, var2, val2, flag, err) Reports a zero-difference between two variables where a non-zero\ndifference was expected. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var1 The name of the first variable. real(kind=real64), intent(in) :: val1 The value of the first variable. character(len=*), intent(in) :: var2 The name of the second variable. real(kind=real64), intent(in) :: val2 The value of the second variable. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_zero_difference_error.html"},{"title":"report_zero_valued_frequency_error – DYNAMICS","text":"public subroutine report_zero_valued_frequency_error(name, index, err) Reports an error associated with a zero-valued frequency value. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: index The array index at which the zero-valued frequency was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Contents Variables errmsg Variables Type Visibility Attributes Name Initial character(len=256), public :: errmsg","tags":"","loc":"proc\\report_zero_valued_frequency_error.html"},{"title":"chirp – DYNAMICS","text":"public pure elemental function chirp(t, amp, span, f1Hz, f2Hz) result(rst) Evaluates a linear chirp function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate the \nchirp. real(kind=real64), intent(in) :: amp The amplitude. real(kind=real64), intent(in) :: span The duration of the time it takes to sweep from the start \nfrequency to the end frequency. real(kind=real64), intent(in) :: f1Hz The lower excitation frequency, in Hz. real(kind=real64), intent(in) :: f2Hz The upper excitation frequency, in Hz. Return Value real(kind=real64) The value of the function at t. Contents","tags":"","loc":"proc\\chirp.html"},{"title":"compute_modal_damping – DYNAMICS","text":"public pure elemental function compute_modal_damping(lambda, alpha, beta) result(rst) Computes the modal damping factors given the\nproportional damping terms and where , , and is the eigenvalue of the system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: lambda The square of the modal frequency - the eigen value. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . Return Value real(kind=real64) The modal damping parameter. Contents","tags":"","loc":"proc\\compute_modal_damping.html"},{"title":"fit_frf – DYNAMICS","text":"public function fit_frf(mt, n, freq, rsp, maxp, minp, init, stats, alpha, controls, settings, info, err) result(rst) Uses peaks Fits an experimentally obtained frequency response by model for either a\nreceptance model: or an accelerance model: . Internally, the code uses a Levenberg-Marquardt solver to determine the\nparameters. The initial guess for the solver is determined by a \npeak finding algorithm used to locate the resonant modes in frequency.\nfrom this result, estimates for both the amplitude and natural frequency\nvalues are obtained. The damping parameters are assumed to be equal\nfor all modes and set to a default value of 0.1. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: mt The excitation method. The options are as follows. FRF_ACCELERANCE_MODEL: Use an accelerance model. FRF_RECEPTANCE_MODEL: Use a receptance model. integer(kind=int32), intent(in) :: n The model order (# of resonant modes). real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the excitation frequency values in \nunits of rad/s. complex(kind=real64), intent(in), dimension(:) :: rsp An M-element array containing the frequency response to fit. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional 3*N-element array that can be used as upper limits on \nthe parameter values. If no upper limit is requested for a particular\nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional 3*N-element array that can be used as lower limits on \nthe parameter values. If no lower limit is requested for a particalar\nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: init An optional 3 N-element array that, if supplied, provides an initial\nguess for each of the 3 N model parameters for the iterative solver.\nIf supplied, this array replaces the peak finding algorithm for\nestimating an initial guess. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional 3*N-element array that, if supplied, will be used to\nreturn statistics about the fit for each model parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence intervals.\nThe default value is 0.05 such that a 95% confidence interval is \ncalculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if freq and rsp are not the same size. DYN_UNDERDEFINED_PROBLEM_EROR: Occurs if the requested model \n order is too high for the number of data points available. DYN_TOLERANCE_TOO_SMALL_ERROR: Occurs if the requested solver \n tolerance is too small to be practical for this problem. DYN_TOO_FEW_ITERATIONS_ERROR: Occurs if convergence cannot be \n achieved in the allowed number of solver iterations. Return Value real(kind=real64), allocatable, dimension(:) An array containing the model parameters stored as . Contents","tags":"","loc":"proc\\fit_frf.html"},{"title":"modal_response – DYNAMICS","text":"public subroutine modal_response(mass, stiff, freqs, modeshapes, err) Uses linalg dynamics_error_handling Computes the modal frequencies and modes shapes for \nmulti-degree-of-freedom system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must\nbe symmetric. real(kind=real64), intent(out), allocatable, dimension(:) :: freqs An allocatable N-element array where the modal frequencies will\nbe returned in ascending order with units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional, allocatable N-by-N matrix where the N mode shapes\nfor the system will be returned. The mode shapes are stored in\ncolumns. class(errors), intent(inout), optional, target :: err Contents","tags":"","loc":"proc\\modal_response.html"},{"title":"normalize_mode_shapes – DYNAMICS","text":"public subroutine normalize_mode_shapes(x) Normalizes mode shape vectors such that the largest magnitude\nvalue in the vector is one. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), dimension(:,:) :: x The matrix of mode shape vectors with one vector per column. Contents","tags":"","loc":"proc\\normalize_mode_shapes.html"},{"title":"evaluate_accelerance_frf_model – DYNAMICS","text":"public interface evaluate_accelerance_frf_model Contents Module Procedures evaluate_accelerance_frf_model_scalar evaluate_accelerance_frf_model_array Module Procedures private pure function evaluate_accelerance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_accelerance_frf_model_array(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function.","tags":"","loc":"interface\\evaluate_accelerance_frf_model.html"},{"title":"evaluate_receptance_frf_model – DYNAMICS","text":"public interface evaluate_receptance_frf_model Contents Module Procedures evaluate_receptance_frf_model_scalar evaluate_receptance_frf_model_array Module Procedures private pure function evaluate_receptance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_receptance_frf_model_array(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function.","tags":"","loc":"interface\\evaluate_receptance_frf_model.html"},{"title":"frequency_response – DYNAMICS","text":"public interface frequency_response Computes the frequency response functions for a system of ODE's. Contents Module Procedures frf_modal_prop_damp frf_modal_prop_damp_2 siso_freqres mimo_freqres Module Procedures private function frf_modal_prop_damp(mass, stiff, alpha, beta, freq, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . real(kind=real64), intent(in), dimension(:) :: freq An M-element array of frequency values at which to evaluate the\nfrequency response functions, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function frf_modal_prop_damp_2(mass, stiff, alpha, beta, nfreq, freq1, freq2, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency, in units of rad/s. real(kind=real64), intent(in) :: freq2 The ending frequency, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function siso_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency response of a single-input, single-output (SISO)\nsystem. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the excitation signal. real(kind=real64), intent(in), dimension(:) :: y An N-element array containing the response signal. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size. Return Value type( frf ) The resulting frequency response function. private function mimo_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency responses of a multiple-input, multiple-output\n(MIMO) system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x An N-by-P array containing the P inputs to the system. real(kind=real64), intent(in), dimension(:,:) :: y An N-by-M array containing the M outputs from the system. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y do not have the same number\n of rows. Return Value type( mimo_frf ) The resulting frequency response functions.","tags":"","loc":"interface\\frequency_response.html"},{"title":"frequency_sweep – DYNAMICS","text":"public interface frequency_sweep Contents Module Procedures frf_sweep_1 frf_sweep_2 Module Procedures private function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, points, inHz, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. The amplitude and phase are determined by means of a harmonic \nprojection method. where Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the frequency points at which the \nsolution should be computed. Notice, whatever units are utilized\nfor this array are also the units of the excitation_frequency\nproperty in sys. Additionally, this array cannot contain any\nzero-valued elements as the ODE solution time for each frequency \nis determined by the period of oscillation and number of cycles. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 5. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 30. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. logical, intent(in), optional :: inHz Set to true if the units of the frequency vector are in Hz. If\nfalse, the units are assumed as rad/s. The default is false such\nthat the frequency units are assumed to be rad/s. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses. private function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, ntransient, points, inHz, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. The amplitude and phase are determined by means of a harmonic \nprojection method. where Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency. real(kind=real64), intent(in) :: freq2 The ending frequency. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 5. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 30. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. logical, intent(in), optional :: inHz Set to true if the units of the frequency units are in Hz. If\nfalse, the units are assumed as rad/s. The default is false such\nthat the frequency units are assumed to be rad/s. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses.","tags":"","loc":"interface\\frequency_sweep.html"},{"title":"harmonic_ode – DYNAMICS","text":"interface public subroutine harmonic_ode(freq, t, x, dxdt, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. real(kind=real64), intent(in) :: t The current time step value. real(kind=real64), intent(in), dimension(:) :: x The value of the solution estimate at time t. real(kind=real64), intent(out), dimension(:) :: dxdt The derivatives as computed by this routine. class(*), intent(inout), optional :: args An optional argument allowing the passing of data in/out of\nthis routine. Description Defines a system of ODE's exposed to harmonic excitation.","tags":"","loc":"interface\\harmonic_ode.html"},{"title":"modal_excite – DYNAMICS","text":"interface public subroutine modal_excite(freq, frc, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. When used as a part of a frequency\nresponse calculation, this value will have the same units as\nthe frequency values provided to the frequency response\nroutine. complex(kind=real64), intent(out), dimension(:) :: frc An N-element array where the forcing function should be\nwritten. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. Description Defines the interface to a routine for defining the forcing\nfunction for a modal frequency analysis.","tags":"","loc":"interface\\modal_excite.html"},{"title":"ode_excite – DYNAMICS","text":"interface public function ode_excite(t) result(rst) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate\nthe excitation function. Return Value real(kind=real64) The result. Description Defines the interface for a ODE excitation function.","tags":"","loc":"interface\\ode_excite.html"},{"title":"is_point_on_line – DYNAMICS","text":"public pure function is_point_on_line(pt, ln, tol) result(rst) Tests to see if a point lies on a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the line; else, false. Contents","tags":"","loc":"proc\\is_point_on_line.html"},{"title":"is_point_on_plane – DYNAMICS","text":"public pure function is_point_on_plane(pt, pln, tol) result(rst) Tests to see if a point lies on a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the plane; else, false. Contents","tags":"","loc":"proc\\is_point_on_plane.html"},{"title":"line_common_normal – DYNAMICS","text":"public pure function line_common_normal(ln1, ln2) result(rst) Returns the common normal line between two lines pointing from ln1 to\nln2. In the event that the two lines are parallel within the \nspecified tolerance, there exist an infinite number of common \nnormals; therefore, a line will be chosen that runs from ln1 to ln2\nwith the point at t = 0 coincident with the point at t = 0 on ln1. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. Return Value type( line ) The common normal line. The distance along this line between\nt = 0 and t = 1 defines the length of the common normal \nconnecting ln1 to ln2. In the event that ln1 and ln2 intersect,\nthe length of this line is zero. Contents","tags":"","loc":"proc\\line_common_normal.html"},{"title":"line_from_point_and_vector – DYNAMICS","text":"public pure function line_from_point_and_vector(pt, x, nx) result(rst) Constructs a new line from a point (defines the point where t = 0)\nand a direction vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point at which t = 0 on the line. real(kind=real64), intent(in) :: x (3) The direction vector defining the orientation of the line. logical, intent(in), optional :: nx An optional parameter that defines if x should be normalized to\na unit vector (true), or left as-is (false). The default is\ntrue such that x is normalized to a unit vector. Return Value type( line ) The resulting line. Contents","tags":"","loc":"proc\\line_from_point_and_vector.html"},{"title":"nearest_point_on_line – DYNAMICS","text":"public pure function nearest_point_on_line(pt, ln) result(rst) Gets the line parameter for the point on the line nearest the \nspecified point. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The line parameteric variable defining the location of\nthe point nearest along the line. Contents","tags":"","loc":"proc\\nearest_point_on_line.html"},{"title":"plane_normal – DYNAMICS","text":"public pure function plane_normal(pln) result(rst) Returns the normal vector of a plane. Arguments Type Intent Optional Attributes Name type( plane ), intent(in) :: pln The plane. Return Value real(kind=real64), (3) The normal vector. Contents","tags":"","loc":"proc\\plane_normal.html"},{"title":"point_plane_projection – DYNAMICS","text":"public pure function point_plane_projection(pt, pln) result(rst) Projects a point onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane onto which to project the point. Return Value real(kind=real64), (3) The projected point. Contents","tags":"","loc":"proc\\point_plane_projection.html"},{"title":"point_to_line_distance – DYNAMICS","text":"public pure function point_to_line_distance(pt, ln) result(rst) Computes the shortest distance between a point and a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The shortest distance between the point and line. Contents","tags":"","loc":"proc\\point_to_line_distance.html"},{"title":"point_to_plane_distance – DYNAMICS","text":"public pure function point_to_plane_distance(pt, pln) result(rst) Computes the shortest distance between a point and a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. Return Value real(kind=real64) The shortest distance between the point and plane. Contents","tags":"","loc":"proc\\point_to_plane_distance.html"},{"title":"vector_plane_projection – DYNAMICS","text":"public pure function vector_plane_projection(x, pln) result(rst) Projects a vector onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector to project. class( plane ), intent(in) :: pln The plane onto which to project the vector. Return Value real(kind=real64), (3) The projected vector. Contents","tags":"","loc":"proc\\vector_plane_projection.html"},{"title":"do_lines_intersect – DYNAMICS","text":"public pure subroutine do_lines_intersect(ln1, ln2, intersect, t1, t2, tol) Tests to see if two lines intersect. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. logical, intent(out) :: intersect True if the two lines intersect within the specified tolerance;\nelse, false if they do not intersect. real(kind=real64), intent(out), optional :: t1 The parametric value associate with ln1 defining the intersection\npoint. real(kind=real64), intent(out), optional :: t2 The parametric value associate with ln2 defining the intersection\npoint. real(kind=real64), intent(in), optional :: tol The intersection tolerance. If not supplied, the default value\nis 10x machine epsilon. Contents","tags":"","loc":"proc\\do_lines_intersect.html"},{"title":"assignment(=) – DYNAMICS","text":"public interface assignment(=) Contents Module Procedures plane_assign line_assign pl_assign pl_assign_line Module Procedures private pure elemental subroutine plane_assign(x, y) Assigns a plane to another. Arguments Type Intent Optional Attributes Name type( plane ), intent(out) :: x The resulting plane. type( plane ), intent(in) :: y The source plane private pure elemental subroutine line_assign(x, y) Assigns a line to another. Arguments Type Intent Optional Attributes Name type( line ), intent(out) :: x The resulting line. type( line ), intent(in) :: y The source line private pure elemental subroutine pl_assign(x, y) Assigns a plucker_line to another. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( plucker_line ), intent(in) :: y The source plucker_line. private pure elemental subroutine pl_assign_line(x, y) Assigns a line to a plucker_line. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( line ), intent(in) :: y The source line.","tags":"","loc":"interface\\assignment(=).html"},{"title":"is_parallel – DYNAMICS","text":"public interface is_parallel Contents Module Procedures is_parallel_vectors is_parallel_lines is_parallel_planes Module Procedures private pure function is_parallel_vectors(x, y, tol) result(rst) Tests to see if two vectors are parallel. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the vectors are parallel; else, false. private pure function is_parallel_lines(x, y, tol) result(rst) Tests to see if two lines are parallel. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: x The first line. class( line ), intent(in) :: y The second line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the lines are parallel; else, false. private pure function is_parallel_planes(x, y, tol) result(rst) Tests to see if two planes are parallel. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: x The first plane. class( plane ), intent(in) :: y The second plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the planes are parallel; else, false.","tags":"","loc":"interface\\is_parallel.html"},{"title":"line – DYNAMICS","text":"public interface line Contents Module Procedures line_from_2pts line_from_2_planes line_from_many_points Module Procedures private pure function line_from_2pts(pt1, pt2) result(rst) Constructs a line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. This point will act as the initial point\nalong the line such that in the\nequation of the line . real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( line ) The resulting line. private pure function line_from_2_planes(p1, p2) result(rst) Constructs a line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function line_from_many_points(pts) result(rst) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts An N-by-3 matrix where N is at least 2, but typically much\nlarger. Return Value type( line ) The resulting line.","tags":"","loc":"interface\\line.html"},{"title":"matmul – DYNAMICS","text":"public interface matmul Contents Module Procedures pl_matmul Module Procedures private pure function pl_matmul(x, y) result(rst) Overloads the matmul routine to allow for multiplication of the\nPlücker line coordinate vector with a matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x The N-by-6 matrix. type( plucker_line ), intent(in) :: y The plucker_line object. Return Value real(kind=real64), allocatable, dimension(:) The resulting N-element array.","tags":"","loc":"interface\\matmul.html"},{"title":"plane – DYNAMICS","text":"public interface plane Contents Module Procedures plane_from_3pts plane_from_point_and_normal plane_from_many_points Module Procedures private pure function plane_from_3pts(pt1, pt2, pt3) result(rst) Constructs a plane from 3 points. The 3 points must not be colinear. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. real(kind=real64), intent(in) :: pt3 (3) The third point. Return Value type( plane ) The resulting plane. private pure function plane_from_point_and_normal(pt, nrm) result(rst) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point that lies on the plane. real(kind=real64), intent(in) :: nrm (3) The normal unit vector. Return Value type( plane ) The resulting plane. private pure function plane_from_many_points(pts) result(rst) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts The N-by-3 matrix containing the N points to fit. N must be\nat least 3, but is typically much larger. Return Value type( plane ) The resulting plane.","tags":"","loc":"interface\\plane.html"},{"title":"plucker_line – DYNAMICS","text":"public interface plucker_line Contents Module Procedures pl_from_2pts pl_from_line pl_from_2_planes pl_from_array Module Procedures private pure function pl_from_2pts(pt1, pt2) result(rst) Constructs a new plucker_line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( plucker_line ) The resulting line. private pure function pl_from_line(ln) result(rst) Constructs a new plucker_line from a line object. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln The line. Return Value type( plucker_line ) The equivalent plucker_line. private pure function pl_from_2_planes(p1, p2) result(rst) Constructs a new plucker_line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( plucker_line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function pl_from_array(x, nrm) result(rst) Constructs a new plucker_line from the supplied array. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (6) A 6-element array containing the Plücker coordinates. logical, intent(in), optional :: nrm An optional input that specifies if the first three coordinates\n(the unit vector) should be normalized (true), or left as-is\n(false). The default is true such that the vector is normalized. Return Value type( plucker_line ) The resulting line.","tags":"","loc":"interface\\plucker_line.html"},{"title":"cross_product – DYNAMICS","text":"public pure function cross_product(x, y) result(rst) Computes the cross-product of a vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The left-hand-side argument. real(kind=real64), intent(in) :: y (3) The right-hand-side argument Return Value real(kind=real64), (3) The resulting vector. Contents","tags":"","loc":"proc\\cross_product.html"},{"title":"scalar_projection – DYNAMICS","text":"public pure function scalar_projection(x, y) result(rst) Computes the projection of vector x onto vector y. The scalar projection\nis defined such that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64) The scalar projection of x onto y. Contents","tags":"","loc":"proc\\scalar_projection.html"},{"title":"to_skew_symmetric – DYNAMICS","text":"public pure function to_skew_symmetric(x) result(rst) Converts a 3-element vector to a 3-by-3 skew-symmetric matrix. A \nskew-symmetric matrix is defined as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector. Return Value real(kind=real64), (3,3) The resulting skew-symmetric matrix. Contents","tags":"","loc":"proc\\to_skew_symmetric.html"},{"title":"vector_angle – DYNAMICS","text":"public pure function vector_angle(x, y) result(rst) Computes the angle between two vectors. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. Return Value real(kind=real64) The angle, in radians. Contents","tags":"","loc":"proc\\vector_angle.html"},{"title":"vector_projection – DYNAMICS","text":"public pure function vector_projection(x, y) result(rst) Computes the vector pojection of vector x onto vector y. The vector\nprojection is defined such that Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64), (3) The vector projection of x onto y. Contents","tags":"","loc":"proc\\vector_projection.html"},{"title":"dh_matrix – DYNAMICS","text":"public pure function dh_matrix(alpha, a, theta, d) result(rst) Computes the Denavit-Hartenberg transformation matrix for the \nspecified DH parameters. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The link twist angle, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in) :: a The link length as measured along the link's x-axis. real(kind=real64), intent(in) :: theta The joint angle, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in) :: d The joint offset distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. Contents","tags":"","loc":"proc\\dh_matrix.html"},{"title":"dh_rotate_x – DYNAMICS","text":"public pure function dh_rotate_x(alpha) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_rotate_x.html"},{"title":"dh_rotate_z – DYNAMICS","text":"public pure function dh_rotate_z(theta) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: theta The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_rotate_z.html"},{"title":"dh_translate_x – DYNAMICS","text":"public pure function dh_translate_x(a) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a The translation. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_translate_x.html"},{"title":"dh_translate_z – DYNAMICS","text":"public pure function dh_translate_z(d) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d The translation. Return Value real(kind=real64), (4,4) The matrix. Contents","tags":"","loc":"proc\\dh_translate_z.html"},{"title":"identity_4 – DYNAMICS","text":"public pure function identity_4() result(rst) Computes a 4-by-4 identity matrix. Arguments None Return Value real(kind=real64), (4,4) The resulting identity matrix. Contents None","tags":"","loc":"proc\\identity_4.html"},{"title":"jacobian_generating_vector – DYNAMICS","text":"public pure function jacobian_generating_vector(d, k, R, jtype) result(rst) Computes a single Jacobian generating vector given the position vector\nof the link origin, , and the joint axis unit vector, . For a revolute joint: For a prismatic joint: The Jacobian matrix is then constructed from the Jacobian generating\nvectors as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d (3) The position vector of the end-effector, , relative to the\nlink coordinate frame given in the base coordinate frame. An easy\nway to compute this vector is to extract the first 3 elements of the\n4th column of the transformation matrix: . real(kind=real64), intent(in) :: k (3) The unit vector defining the joint axis, , given in the\nbase coordinate frame. This vector can be computed most easily by\nusing the transformation matrix: and\nthen computing . real(kind=real64), intent(in) :: R (3,3) The rotation matrix defining the orientation of the link coordinate\nframe relative to the base coordinate frame. integer(kind=int32), intent(in) :: jtype The joint type. Must be either REVOLUTE_JOINT or PRISMATIC_JOINT.\nIf incorrectly specified, the code defaults to a REVOLUTE_JOINT type. Return Value real(kind=real64), (6) The resulting 6-element Jacobian generating vector. Contents","tags":"","loc":"proc\\jacobian_generating_vector.html"},{"title":"solve_inverse_kinematics – DYNAMICS","text":"public function solve_inverse_kinematics(mdl, qo, constraints, df, slvr, ib, jfcn, qmax, qmin, args, err) result(rst) Solves the inverse kinematics problem for a linkage. An iterative\nsolution procedure is utilized. Arguments Type Intent Optional Attributes Name procedure(vecfcn), intent(in), pointer :: mdl A routine used to compute the forward kinematics for the linkage\ngiven the current joint variable estimates. real(kind=real64), intent(in), dimension(:) :: qo An M-element array containing an initial estimate of the M joint\nvariables. real(kind=real64), intent(in), target, dimension(:) :: constraints An N-element array containing the target values (constraints) for\neach of the N kinematic equations in the model. N must be at \nleast equal to M (the number of joint variables). real(kind=real64), intent(out), optional, target, dimension(:) :: df An optional N-element array that, if supplied, can be used to \nretrieve the residuals of each of the N kinematic equations. class(constrained_equation_solver), intent(inout), optional, target :: slvr An optional solver that can be used in place of the default\nLevenberg-Marquardt solver. type(iteration_behavior), intent(out), optional :: ib An optional output that can be used to gather information on the\nsolver. procedure(jacobianfcn), intent(in), optional, pointer :: jfcn A routine that can be used to provide the Jacobian matrix for\nthe linkage. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmax An optional set of upper limits on each of the joint variables.\nIf not provided, the default is the output of the 'huge' \nintrinsic function. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmin An optional set of lower limits on each of the joint variables.\nIf not provided, the default is the negative of the output of \nthe 'huge' intrinsic function. class(*), intent(inout), optional, target :: args An optional argument that can be used to communicate with mdl. class(errors), intent(inout), optional, target :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Return Value real(kind=real64), allocatable, dimension(:) An M-element array containing the computed joint variables. Contents","tags":"","loc":"proc\\solve_inverse_kinematics.html"},{"title":"coordinate_system – DYNAMICS","text":"public interface coordinate_system Contents Module Procedures define_link_csys define_csys Module Procedures private pure function define_link_csys(xim1, zim1, zi, rim1, ri) result(rst) Defines the DH coordinate system for the specified link. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: xim1 (3) The x-axis of the previous link. real(kind=real64), intent(in) :: zim1 (3) The z-axis of the previous link. This is also the axis of the\nproximal joint of the current link. real(kind=real64), intent(in) :: zi (3) The axis of the distal joint of the current link. real(kind=real64), intent(in) :: rim1 (3) The location of the proximal joint's center or home position. real(kind=real64), intent(in) :: ri (3) The location of the distal joint's center or home position. Return Value type( coordinate_system ) The resulting coordinate system. private pure function define_csys(i, j, k, o) result(rst) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The x-axis unit vector. real(kind=real64), intent(in) :: j (3) The y-axis unit vector. real(kind=real64), intent(in) :: k (3) The x-axis unit vector. real(kind=real64), intent(in), optional :: o (3) The location of the coordinate system within a reference \ncoordinate system. If not supplied, a value of (0, 0, 0) will\nbe used. Return Value type( coordinate_system ) The new coordinate_system object.","tags":"","loc":"interface\\coordinate_system.html"},{"title":"dh_forward_kinematics – DYNAMICS","text":"public interface dh_forward_kinematics Contents Module Procedures dh_forward_kinematics_2 dh_forward_kinematics_3 dh_forward_kinematics_4 dh_forward_kinematics_5 dh_forward_kinematics_6 dh_forward_kinematics_7 dh_forward_kinematics_8 dh_forward_kinematics_array dh_forward_kinematics_dh_params dh_forward_kinematics_dh_table Module Procedures private pure function dh_forward_kinematics_2(T1, T2) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_3(T1, T2, T3) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_4(T1, T2, T3, T4) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_5(T1, T2, T3, T4, T5) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_6(T1, T2, T3, T4, T5, T6) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_7(T1, T2, T3, T4, T5, T6, T7) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_8(T1, T2, T3, T4, T5, T6, T7, T8) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. real(kind=real64), intent(in) :: T8 (4,4) The transformation matrix for the eigth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_array(alpha, a, theta, d) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. The first entry must\nbe from the first link nearest ground. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_params(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_parameter_set ), intent(in), dimension(:) :: x The list of DH parameters. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_table(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_table ), intent(in) :: x The DH table. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix.","tags":"","loc":"interface\\dh_forward_kinematics.html"},{"title":"dh_jacobian – DYNAMICS","text":"public interface dh_jacobian Contents Module Procedures dh_build_jacobian Module Procedures private function dh_build_jacobian(alpha, a, theta, d, jtypes) result(rst) Builds the Jacobian matrix for a linkage given the Denavit-Hartenberg\nparameters. The first entry in each array must be from the first link\nnearest ground. The Jacobian matrix relates the joint velocities to the end-effector velocity by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. integer(kind=int32), intent(in), dimension(size(alpha)) :: jtypes The types of each joint. Must be either REVOLUTE_JOINT or\nPRISMATIC_JOINT. The code defaults to REVOLUTE_JOINT. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-N Jacobian matrix where N is the number of joint\nvariables (i.e. the length of the input arrays).","tags":"","loc":"interface\\dh_jacobian.html"},{"title":"dh_parameter_set – DYNAMICS","text":"public interface dh_parameter_set Contents Module Procedures dps_init Module Procedures private pure function dps_init(length, twist, offset, angle) result(rst) Constructs a new dh_parameter_set object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: length The link length. real(kind=real64), intent(in) :: twist The link twist. real(kind=real64), intent(in) :: offset The link offset. real(kind=real64), intent(in) :: angle The joint angle. Return Value type( dh_parameter_set ) The new dh_parameter_set object.","tags":"","loc":"interface\\dh_parameter_set.html"},{"title":"dh_table – DYNAMICS","text":"public interface dh_table Contents Module Procedures dh_table_init Module Procedures private pure function dh_table_init(c) result(rst) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Arguments Type Intent Optional Attributes Name class( coordinate_system ), intent(in), dimension(:) :: c An N-element array containing the coordinate frames for each\nof the N links of the linkage. Return Value type( dh_table ) The resulting Denavit-Hartenberg table.","tags":"","loc":"interface\\dh_table.html"},{"title":"binary_link – DYNAMICS","text":"public interface binary_link Contents Module Procedures bl_init Module Procedures private pure function bl_init(jtype, length, twist, offset, angle, mass, inertia, cg) result(rst) Initializes a new parallel_revolute_revolute_link instance. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in), optional :: jtype The proximal joint type. This value must be either &\nREVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, \nthis parameter defaults to REVOLUTE_JOINT. real(kind=real64), intent(in), optional :: length The link length. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: twist The link twist angle. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: offset The link offset. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: angle The joint angle offset. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: mass The mass of the link. If no value is specified, a value of 1 is\nused. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not specified, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the distal coordinate\nframe, expressed in the link coordinate frame. If not supplied,\nthe CG is set to (0, 0, 0) such that it is located at the center\nof the distal joint. Return Value type( binary_link ) The resulting binary_link object.","tags":"","loc":"interface\\binary_link.html"},{"title":"serial_linkage – DYNAMICS","text":"public interface serial_linkage Contents Module Procedures sl_init Module Procedures private function sl_init(lnks) result(rst) Initializes a new serial_linkage object. Arguments Type Intent Optional Attributes Name class( binary_link ), intent(in), dimension(:) :: lnks A collection of binary_link objects. The collection starts with\nthe first link and progresses to the end-effector in a \nsequential manner. Return Value type( serial_linkage ) The serial_linkage instance.","tags":"","loc":"interface\\serial_linkage.html"},{"title":"poincare_map – DYNAMICS","text":"public pure function poincare_map(x, y, z, pln, side) result(rst) Generates a Poincare map by determining the intersections of the\nsupplied trajectory with the specified plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The x-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: y The y-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: z The z-coordinates of the trajectory. class( plane ), intent(in), optional :: pln The plane to intersect. If not supplied, the x-y plane is \nutilized where z = 0. integer(kind=int32), intent(in), optional :: side An integer flag denoting which approach to use when computing\nthe section. The acceptable values are as follows. POINCARE_TWO_SIDED (Default): A two-sided Poincare section \nwill be computed. In this section, the algorithm does not care \nwhether the trajectory approaches the sectioning plane from the \nfront or the back of the plane (defined by the plane normal). It simply returns any intersection point. POINCARE_ONE_SIDED_FROM_FRONT: A one-sided Poincare section \nwill be computed where the algorithm only retains intersection \npoints where the trajectory approaches the sectioning plane from \nthe front (the side of the plane normal). POINCARE_ONE_SIDED_FROM_BACK: A one-sided Poincare section \nwill be computed where the algorithm only retains intersection \npoints where the trajectory approaches the sectioning plane from \nthe back (the side opposite the plane normal). Return Value real(kind=real64), allocatable, dimension(:,:) An N-by-3 matrix containing the x, y, and z coordinates of each\nof the N intersection points in the first, second, and third\ncolumns respectively. Contents","tags":"","loc":"proc\\poincare_map.html"},{"title":"inverse – DYNAMICS","text":"public pure elemental function inverse(q) result(rst) Computes the inverse of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The inverse of the supplied quaternion. Contents","tags":"","loc":"proc\\inverse.html"},{"title":"abs – DYNAMICS","text":"public interface abs Contents Module Procedures quat_abs Module Procedures private pure elemental function quat_abs(q) result(rst) Computes the magnitude of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The magnitude of the quaternion.","tags":"","loc":"interface\\abs.html"},{"title":"aimag – DYNAMICS","text":"public interface aimag Contents Module Procedures quat_aimag Module Procedures private pure function quat_aimag(q) result(rst) Returns the imaginary component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(3) The imaginary component as a vector.","tags":"","loc":"interface\\aimag.html"},{"title":"assignment(=) – DYNAMICS","text":"public interface assignment(=) Contents Module Procedures quat_assign quat_assign_vec4 Module Procedures private pure elemental subroutine quat_assign(x, y) Assigns a quaternion to another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. type( quaternion ), intent(in) :: y The source quaternion. private pure subroutine quat_assign_vec4(x, y) Assigns a 4-element vector to a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. real(kind=real64), intent(in), dimension(4) :: y The source vector.","tags":"","loc":"interface\\assignment(=)~2.html"},{"title":"conjg – DYNAMICS","text":"public interface conjg Contents Module Procedures quat_conjg Module Procedures private pure elemental function quat_conjg(q) result(rst) Computes the conjugate of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The conjugate of the quaternion.","tags":"","loc":"interface\\conjg.html"},{"title":"dot_product – DYNAMICS","text":"public interface dot_product Contents Module Procedures quat_dot_prd Module Procedures private pure elemental function quat_dot_prd(x, y) result(rst) Computes the dot product of two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value real(kind=real64) The dot product.","tags":"","loc":"interface\\dot_product.html"},{"title":"exp – DYNAMICS","text":"public interface exp Contents Module Procedures quat_exp Module Procedures private pure elemental function quat_exp(q) result(rst) Evaluates the exponential function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\exp.html"},{"title":"log – DYNAMICS","text":"public interface log Contents Module Procedures quat_log Module Procedures private pure elemental function quat_log(q) result(rst) Evalautes the natural logarithm function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\log.html"},{"title":"operator(*) – DYNAMICS","text":"public interface operator(*) Contents Module Procedures quat_scalar_mult scalar_quat_mult quat_multiply quat_vec3_mult Module Procedures private pure elemental function quat_scalar_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function scalar_quat_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The scalar. type( quaternion ), intent(in) :: y The quaternion. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_multiply(x, y) result(rst) Multiplies two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure function quat_vec3_mult(x, y) result(rst) Multiplies a quaternion with a 3-element vector. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in), dimension(3) :: y The vector. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(ASTERISK)~2.html"},{"title":"operator(**) – DYNAMICS","text":"public interface operator(**) Contents Module Procedures quat_pwr quat_int_pwr Module Procedures private pure elemental function quat_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. real(kind=real64), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_int_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. integer(kind=int32), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(ASTERISKASTERISK).html"},{"title":"operator(+) – DYNAMICS","text":"public interface operator(+) Contents Module Procedures quat_add Module Procedures private pure elemental function quat_add(x, y) result(rst) Adds two quaternions together. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(+).html"},{"title":"operator(-) – DYNAMICS","text":"public interface operator(-) Contents Module Procedures quat_subtract quat_negate Module Procedures private pure elemental function quat_subtract(x, y) result(rst) Subtracts two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_negate(x) result(rst) Negates a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(-).html"},{"title":"operator(/) – DYNAMICS","text":"public interface operator(/) Contents Module Procedures quat_scalar_div quat_divide Module Procedures private pure elemental function quat_scalar_div(x, y) result(rst) Divides a quaternion by a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_divide(x, y) result(rst) Divides a quaternion by another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\operator(SLASH).html"},{"title":"quaternion – DYNAMICS","text":"public interface quaternion Contents Module Procedures quat_init_array quat_init_angle_axis quat_init_mtx Module Procedures private pure function quat_init_array(x) result(rst) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(4) :: x The array from which to initialize the quaternion stored in the\norder [w, x, y, z]. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_angle_axis(angle, axis) result(rst) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. real(kind=real64), intent(in), dimension(3) :: axis A 3-element vector defining the axis about which the rotation\noccurrs. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_mtx(r) result(rst) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(3, 3) :: r The rotation matrix. Return Value type( quaternion ) The resulting quaternion.","tags":"","loc":"interface\\quaternion.html"},{"title":"real – DYNAMICS","text":"public interface real Contents Module Procedures quat_real Module Procedures private pure elemental function quat_real(q) result(rst) Returns the real component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The real component.","tags":"","loc":"interface\\real.html"},{"title":"initialize_rigid_body – DYNAMICS","text":"public pure subroutine initialize_rigid_body(bdy, m, inertia, cg) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name class( rigid_body ), intent(inout) :: bdy The rigid_body object. real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Contents","tags":"","loc":"proc\\initialize_rigid_body.html"},{"title":"rigid_body – DYNAMICS","text":"public interface rigid_body Contents Module Procedures rb_init Module Procedures private pure function rb_init(m, inertia, cg) result(rst) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Return Value type( rigid_body ) The rigid_body object.","tags":"","loc":"interface\\rigid_body.html"},{"title":"acceleration_transform – DYNAMICS","text":"public pure function acceleration_transform(alpha, omega, a, x) result(rst) Computes the acceleration transformation matrix relating the\nposition of a point expressed in a rotating and translating body\nrelative to its parent frame. The transformation matrix takes the following form. where, and, Given a vector describing the location on a moving body, , the matrix is used to report its acceleration . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha (3) The angular acceleration vector. real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: a (3) The translational acceleration vector describing the acceleration\nof the body in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. Contents","tags":"","loc":"proc\\acceleration_transform.html"},{"title":"rotate_x – DYNAMICS","text":"public pure function rotate_x(angle) result(rst) Constructs the rotation matrix describing a rotation about an\nx-axis such that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Contents","tags":"","loc":"proc\\rotate_x.html"},{"title":"rotate_y – DYNAMICS","text":"public pure function rotate_y(angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Contents","tags":"","loc":"proc\\rotate_y.html"},{"title":"rotate_z – DYNAMICS","text":"public pure function rotate_z(angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Contents","tags":"","loc":"proc\\rotate_z.html"},{"title":"velocity_transform – DYNAMICS","text":"public pure function velocity_transform(omega, v, x) result(rst) Computes the velocity transformation matrix relating the position\nof a point expressed in a rotating and translating body relative to\nits parent frame. The transformation matrix takes the following form. where, Given a vector describing the location on a moving body, , the matrix is used to report its velocity . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: v (3) The translation velocity vector describing the velocity of the\nbody in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. Contents","tags":"","loc":"proc\\velocity_transform.html"},{"title":"to_angle_axis – DYNAMICS","text":"public pure subroutine to_angle_axis(r, angle, axis) Extracts the equivalent rotation angle and axis of rotation given a\n3-by-3 rotation matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: r (3,3) The 3-by-3 rotation matrix. real(kind=real64), intent(out) :: angle The rotation angle. real(kind=real64), intent(out) :: axis (3) The axis of rotation. Contents","tags":"","loc":"proc\\to_angle_axis.html"},{"title":"rotate – DYNAMICS","text":"public interface rotate Contents Module Procedures rotate_general_1 rotate_general_2 Module Procedures private pure function rotate_general_1(i, j, k, Ip, Jp, Kp) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. real(kind=real64), intent(in) :: Ip (3) The parent coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: Jp (3) The parent coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: Kp (3) The parent coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. private pure function rotate_general_2(i, j, k) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. The parent coordinate frame is assumed to be as follows. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix.","tags":"","loc":"interface\\rotate.html"},{"title":"determine_local_stability – DYNAMICS","text":"public function determine_local_stability(a, ev, err) result(rst) Determines the nature of stability/unstability near the point at which\nthe dynamics matrix was computed. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a An N-by-N matrix containing the 'A' matrix, also known as the\ndynamics matrix. complex(kind=real64), intent(out), optional, dimension(:) :: ev An optional N-element array that, if supplied, will be filled with \nthe eigenvalues of the matrix A. class(errors), intent(inout), optional, target :: err An error handler object. Return Value integer(kind=int32) Describe the output constants Contents","tags":"","loc":"proc\\determine_local_stability.html"},{"title":"create_connectivity_matrix – DYNAMICS","text":"public function create_connectivity_matrix(gdof, e, nodes, err) result(rst) Creates a connectivity matrix for the element. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: gdof The number of global degrees of freedom. class( element ), intent(in) :: e The element. class( node ), intent(in), dimension(:) :: nodes The global node list. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. Contents","tags":"","loc":"proc\\create_connectivity_matrix.html"},{"title":"restore_constrained_values – DYNAMICS","text":"public function restore_constrained_values(gdof, x, err) result(rst) Restores the constrained degrees-of-freedom from the boundary conditions\napplied by apply_boundary_conditions. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The constrained vector. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector. Contents","tags":"","loc":"proc\\restore_constrained_values.html"},{"title":"shape_function_derivative – DYNAMICS","text":"public pure function shape_function_derivative(index, elem, s, i) result(rst) Computes the derivative of the shape function with respect to the natural\ncoordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. Contents","tags":"","loc":"proc\\shape_function_derivative.html"},{"title":"shape_function_second_derivative – DYNAMICS","text":"public pure function shape_function_second_derivative(index, elem, s, i) result(rst) Computes the second derivative of the shape function with respect to the\nnatural coordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. Contents","tags":"","loc":"proc\\shape_function_second_derivative.html"},{"title":"apply_displacement_constraint – DYNAMICS","text":"public subroutine apply_displacement_constraint(dof, val, k, f) Applies a displacement constraint to the specified degree of freedom. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: dof The global degree-of-freedom to which the constraint should be\napplied. real(kind=real64), intent(in) :: val The value of the displacement constraint. real(kind=real64), intent(inout), dimension(:,:) :: k The stiffness matrix to which the constraint should be applied. real(kind=real64), intent(inout), dimension(:) :: f The external force vector to which the constraint should be applied. Contents","tags":"","loc":"proc\\apply_displacement_constraint.html"},{"title":"apply_boundary_conditions – DYNAMICS","text":"public interface apply_boundary_conditions Contents Module Procedures apply_boundary_conditions_mtx apply_boundary_conditions_vec Module Procedures private function apply_boundary_conditions_mtx(gdof, x, err) result(rst) Applies boundary conditions to a matrix by removal of the appropriate\nrows and columns. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:,:) :: x The matrix to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The altered matrix. private function apply_boundary_conditions_vec(gdof, x, err) result(rst) Applies boundary conditions to a vector by removal of the appropriate\nitems. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The vector to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector.","tags":"","loc":"interface\\apply_boundary_conditions.html"},{"title":"constraint_equations – DYNAMICS","text":"interface public subroutine constraint_equations(xg, fg, xc, p, fc, args) Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: xg An N-element array containing the N independent variable\nvalues for the N differential equation solution points. real(kind=real64), intent(in), dimension(:) :: fg An N-element array containing the N differential equation\nsolution points. real(kind=real64), intent(in), dimension(:) :: xc An M-element array containing the M independent variable\nvalues for the M constraint equations. real(kind=real64), intent(in), dimension(:) :: p An array containing the model parameters. real(kind=real64), intent(out), dimension(:) :: fc An M-element array where the values of the constraint \nequations should be written. class(*), intent(inout), optional :: args An optional argument that can be used to pass data in/out\nof this routine. Description An interface to a set of routines for defining constraint \nequations to the fitting process.","tags":"","loc":"interface\\constraint_equations.html"},{"title":"siso_model_fit_least_squares – DYNAMICS","text":"public interface siso_model_fit_least_squares Contents Module Procedures siso_model_fit_least_squares_1 siso_model_fit_least_squares_2 Module Procedures private subroutine siso_model_fit_least_squares_1(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector for the equations in fcn. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object. private subroutine siso_model_fit_least_squares_2(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:,:) :: ic An M-by-NEQN matrix of initial condition vectors for the NEQN \nequations in fcn, one set for each of the M sets of data in x. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object.","tags":"","loc":"interface\\siso_model_fit_least_squares.html"},{"title":"damping_from_fractional_overshoot – DYNAMICS","text":"public pure function damping_from_fractional_overshoot(x) result(rst) Employs the method of fractional overshoot to estimate the damping ratio\nfrom the response of a system to a step input. This method is useful\nfor cases where the damping ratio is between approximately 0.5 to 0.8.\nIn such range, the logarithmic decrement approach becomes less precise. The fractional overshoot method locates the amplitude of the first\npeak of oscillation ( ) and the settling amplitude ( ), and\nthe estimates the damping ratio as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The estimated damping ratio. Contents","tags":"","loc":"proc\\damping_from_fractional_overshoot.html"},{"title":"damping_from_log_decrement – DYNAMICS","text":"public pure elemental function damping_from_log_decrement(delta) result(rst) Computes the damping ratio from the logarithmic decrement .\nThe damping ratio is related to the logarithmic decrement by the \nfollowing relationship. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: delta The logarithmic decrement. Return Value real(kind=real64) The damping ratio. Contents","tags":"","loc":"proc\\damping_from_log_decrement.html"},{"title":"estimate_bandwidth – DYNAMICS","text":"public pure elemental function estimate_bandwidth(fn, zeta) result(rst) Estimates the bandwidth of the resonant mode of a vibratory system.\nThe bandwidth is the width of the range of frequencies for which the\nenergy is at least half its peak value and is computed as . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: fn The resonant frequency. The units are not important; however, \nthe units of the output will be the same as the units of this\nparameter. real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The bandwidth. Contents","tags":"","loc":"proc\\estimate_bandwidth.html"},{"title":"evaluate_step_response – DYNAMICS","text":"public pure elemental function evaluate_step_response(wn, zeta, xs, t) result(rst) Evaluates the response of an underdamped single-degree-of-freedom, \nlinear system to a step function of amplitude . The step function response of an underdamped linear SDOF system is given\nas follows. where, and Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio. real(kind=real64), intent(in) :: xs The amplitude of the step input. real(kind=real64), intent(in) :: t The point in time at which to evaluate the response (units = s). Return Value real(kind=real64) The step response. Contents","tags":"","loc":"proc\\evaluate_step_response.html"},{"title":"find_settling_amplitude – DYNAMICS","text":"public pure function find_settling_amplitude(x) result(rst) Uses fftpack Estimates the settling amplitude for a step response. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The settling amplitude of the step response. Contents","tags":"","loc":"proc\\find_settling_amplitude.html"},{"title":"logarithmic_decrement – DYNAMICS","text":"public pure elemental function logarithmic_decrement(x1, x2, n) result(rst) Computes the logarithmic decrement given the value of two successive\npeaks in the time history of the free vibratory response of the system.\nThe logarithmic decrement is calculated as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x1 The amplitude of the first peak. real(kind=real64), intent(in) :: x2 The amplitude of the second peak that occurs N periods after the\nfirst. integer(kind=int32), intent(in) :: n The number of periods of oscillation seperating the two peaks. Return Value real(kind=real64) The logarithmic decrement . Contents","tags":"","loc":"proc\\logarithmic_decrement.html"},{"title":"q_factor – DYNAMICS","text":"public pure elemental function q_factor(zeta) result(rst) Estimates the Q-factor for a vibratory system. The Q-factor is computed . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The Q-factor. Contents","tags":"","loc":"proc\\q_factor.html"},{"title":"rise_time – DYNAMICS","text":"public pure elemental function rise_time(wn, zeta) result(rst) Computes the rise time for an underdamped, second-order system. The\nrise time is the time it takes for the system response to go from 0%\nto 100% of its final value and is given by the following relationship. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency of the system, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio of the system. This value must be less than 1\nas this relationship is only valid for an underdamped system. Return Value real(kind=real64) The rise time, in units of seconds. Contents","tags":"","loc":"proc\\rise_time.html"},{"title":"find_free_response_properties – DYNAMICS","text":"public subroutine find_free_response_properties(t, x, delta, fn, x1, x2, t1, t2, s, n) Given a free-response time history, this routine attempts to find the \nlogarithmic decrement and resonant frequency of a vibratory system. The\nlogarithmic decrement is estimated by finding successive peaks by\nmeans of peak detection. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: t An N-element array containing the values in time real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the response sampled at the time points\ngiven in t. real(kind=real64), intent(out) :: delta The logarithmic decrement estimate. If sufficient peaks cannot be\nlocated, the routine returns NaN. real(kind=real64), intent(out) :: fn The damped resonant frequency in units of Hz, assuming that the\ntime values are in seconds. If the time units are not in seconds,\nthe units will be cycle/unit time with unit time being the units\nin which t is supplied. If sufficient peaks cannot be located, the \nroutine returns NaN. real(kind=real64), intent(out), optional :: x1 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the first peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: x2 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the second peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: t1 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the first peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(out), optional :: t2 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the second peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(in), optional :: s An optional input that, if provided, allows for control of the \nsensitivity of the peak detection algorithm. The default is 0.1%\nof the peak-peak amplitude of the signal. integer(kind=int32), intent(in), optional :: n An optional input that, if provided, determines the number of \nperiods to allow between peak selection for the logarithmic \ndecrement calculation. The default is 1. Contents","tags":"","loc":"proc\\find_free_response_properties.html"},{"title":"dynamics – DYNAMICS","text":"Uses dynamics_frequency_response dynamics_quaternions dynamics_system_id dynamics_helper dynamics_geometry dynamics_linkage dynamics_kinematics dynamics_stability dynamics_structural dynamics_vibrations dynamics_rotation dynamics_controls Contents None","tags":"","loc":"module\\dynamics.html"},{"title":"dynamics_controls – DYNAMICS","text":"Uses linalg nonlin_polynomials dynamics_error_handling ieee_arithmetic lapack iso_fortran_env diffeq ferror Contents Interfaces operator(*) ss_excitation state_space transfer_function Derived Types state_space transfer_function Functions lti_solve Interfaces public interface operator(*) private function tf_tf_mult(x, y) result(rst) Multiplies two transfer functions. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function poly_tf_mult(x, y) result(rst) Multiplies a polynomial and a transfer function to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_poly_mult(x, y) result(rst) Multiplies a transfer function and a polynomial to result in a new\ntransfer function. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. class(polynomial), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function tf_scalar_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name class( transfer_function ), intent(in) :: x The left-hand-side argument. real(kind=real64), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. private function scalar_tf_mult(x, y) result(rst) Multiplies a transfer function by a scalar value. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The left-hand-side argument. class( transfer_function ), intent(in) :: y The right-hand-side argument. Return Value type( transfer_function ) The resulting transfer function. interface public subroutine ss_excitation(t, u, args) A routine for computing the excitation vector for a state-space\nmodel. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The time value at which to compute the excitation. real(kind=real64), intent(out), dimension(:) :: u The excitation vector. class(*), intent(inout), optional :: args An optional argument used to pass objects in and out of the\nroutine. public interface state_space private pure function state_space_init(m, b, k, n_out) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: m The N-by-N mass matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: b The N-by-N damping matrix. real(kind=real64), intent(in), dimension(size(m, 1), size(m, 2)) :: k The N-by-N stiffness matrix. integer(kind=int32), intent(in), optional :: n_out The number of outputs. The default is 1. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_scalar(m, b, k) result(rst) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: m The mass. real(kind=real64), intent(in) :: b The damping. real(kind=real64), intent(in) :: k The stiffness. Return Value type( state_space ) The [[state_space]] model. private pure function state_space_init_matrices(a, b, c, d) result(rst) Initializes the state space model. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix. real(kind=real64), intent(in), dimension(:,:) :: b The N-by-M input matrix. real(kind=real64), intent(in), dimension(:,:) :: c The P-by-N output matrix. real(kind=real64), intent(in), dimension(:,:) :: d The P-by-M feedthrough matrix. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid(kp, ki, kd, tau, a, b, c, d) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . real(kind=real64), intent(in), dimension(:,:) :: a The N-by-N dynamics matrix for the plant. real(kind=real64), intent(in), dimension(size(a, 1), 1) :: b The N-by-1 input matrix for the plant. real(kind=real64), intent(in), dimension(1, size(a, 1)) :: c The 1-by-N output matrix for the plant. real(kind=real64), intent(in), dimension(1, 1) :: d The 1-by-1 feedthrough matrix for the plant. Return Value type( state_space ) The resulting [[state_space]] object. private pure function state_space_init_pid_plant(kp, ki, kd, tau, plant) result(rst) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: kp The proportional gain term. real(kind=real64), intent(in) :: ki The integral gain term. real(kind=real64), intent(in) :: kd The derivative gain term. real(kind=real64), intent(in) :: tau The time constant of the first order derivative filter . class( state_space ), intent(in) :: plant The plant model. Return Value type( state_space ) The resulting [[state_space]] object. public interface transfer_function private function init_tf_array(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . real(kind=real64), intent(in), dimension(:) :: x The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . Return Value type( transfer_function ) The resulting [[transfer_function]]. private function init_tf_poly(y, x) result(rst) Initializes a new transfer function. Arguments Type Intent Optional Attributes Name class(polynomial), intent(in) :: y The numerator polynomial in . class(polynomial), intent(in) :: x The denominator polynomial in . Return Value type( transfer_function ) The resulting [[transfer_function]]. Derived Types type, public :: state_space Defines a state-space representation of a dynamic system. This\nimplementation takes the form: Read more… Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:,:) :: A The N-by-N dynamics matrix, where N is the number of state\nvariables. real(kind=real64), public, allocatable, dimension(:,:) :: B The N-by-M input matrix, where M is the number of inputs. real(kind=real64), public, allocatable, dimension(:,:) :: C The P-by-N output matrix, where P is the number of outputs. real(kind=real64), public, allocatable, dimension(:,:) :: D The P-by-M feedthrough matrix. Constructor private\n\n pure\n function state_space_init (m, b, k, n_out) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. private\n\n pure\n function state_space_init_scalar (m, b, k) Initializes the state space model. The output matrix is initialized to one, and the\nfeedthrough matrix is initialized to zero. private\n\n pure\n function state_space_init_matrices (a, b, c, d) Initializes the state space model. private\n\n pure\n function state_space_init_pid (kp, ki, kd, tau, a, b, c, d) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. private\n\n pure\n function state_space_init_pid_plant (kp, ki, kd, tau, plant) Initializes a state-space model that employs a closed-loop PID\ncontroller. The PID model is augmented into the plant model as follows. Where the augmented matrices are as follows. Type-Bound Procedures procedure\n , public\n :: evaluate_derivatives =>\n ss_eval_deriv Function procedure\n , public\n :: evaluate_output =>\n ss_eval_output Function procedure\n , public\n :: poles =>\n ss_poles Function generic,\n public\n :: transfer_function =>\n ss_transfer_fcn, ss_transfer_fcn_omega, ss_transfer_fcn_array, ss_transfer_fcn_omega_array procedure\n , public\n :: zeros =>\n ss_zeros Function type, public :: transfer_function Defines a transfer function for a continuous system of the form . Components Type Visibility Attributes Name Initial type(polynomial), public :: X The denominator polynomial in . The polynomial coefficients\nare stored in acending order such that . type(polynomial), public :: Y The numerator polynomial in . The polynomial coefficients\nare stored in acending order such that . Constructor private\n\n \n function init_tf_array (y, x) Initializes a new transfer function. private\n\n \n function init_tf_poly (y, x) Initializes a new transfer function. Type-Bound Procedures generic,\n public\n :: evaluate =>\n tf_eval_omega, tf_eval_s procedure\n , public\n :: poles =>\n tf_poles Function procedure\n , public\n :: to_ccf_state_space =>\n tf_to_ccf_statespace Function procedure\n , public\n :: to_ocf_state_space =>\n tf_to_ocf_statespace Function procedure\n , public\n :: zeros =>\n tf_zeros Function Functions public function lti_solve (mdl, u, t, ic, solver, args, err) result(rst) Solves the LTI system given by the specified state space model. Arguments Type Intent Optional Attributes Name class( state_space ), intent(in), target :: mdl The state_space model to solve. procedure( ss_excitation ), intent(in), pointer :: u The routine used to compute the excitation vector. real(kind=real64), intent(in), dimension(:) :: t The time points at which to compute the solution. The array must\nhave at least 2 values; however, more may be specified. If only\n2 values are specified, the integrator will compute the solution at\nthose points, but it will also return any intermediate integration\nsteps that may be required. However, if more than 2 points are\ngiven, the integrator will return the solution values only at the\nspecified time points. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector. This array must be the same size as\nthe number of state variables. class(ode_integrator), intent(in), optional, target :: solver The ODE solver to utilize. If not specified, the default solver\nis a 4th/5th order Runge-Kutta integrator. class(*), intent(inout), optional :: args An optional container for arguments to pass to the excitation\nroutine. class(errors), intent(inout), optional, target :: err An error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The solution. The time points at which the solution was evaluated\nare stored in the first column and the output(s) are stored in the\nremaining column(s).","tags":"","loc":"module\\dynamics_controls.html"},{"title":"dynamics_error_handling – DYNAMICS","text":"Uses diffeq_errors fstats_errors iso_fortran_env nonlin_error_handling ferror Contents Variables DYN_ARRAY_SIZE_ERROR DYN_CONSTRAINT_ERROR DYN_CONVERGENCE_ERROR DYN_INDEX_OUT_OF_RANGE DYN_INVALID_INPUT_ERROR DYN_MATRIX_SIZE_ERROR DYN_MEMORY_ERROR DYN_NONMONOTONIC_ARRAY_ERROR DYN_NULL_POINTER_ERROR DYN_TOLERANCE_TOO_SMALL_ERROR DYN_TOO_FEW_ITERATIONS_ERROR DYN_UNDERDEFINED_PROBLEM_EROR DYN_ZERO_VALUED_FREQUENCY_ERROR Subroutines report_array_index_out_of_bounds_error report_array_size_error report_constraint_count_error report_convergence_error report_generic_counting_error report_matrix_size_error report_matrix_size_mismatch_error report_memory_error report_nonmonotonic_array_error report_nonsquare_mass_matrix_error report_nonsquare_matrix_error report_nonsquare_stiffness_matrix_error report_null_forcing_routine_error report_null_solver_routine_error report_overconstraint_error report_zero_difference_error report_zero_valued_frequency_error Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: DYN_ARRAY_SIZE_ERROR = 100105 Defines an error for an improperly sized array. integer(kind=int32), public, parameter :: DYN_CONSTRAINT_ERROR = 100102 Defines a constraint-related error. integer(kind=int32), public, parameter :: DYN_CONVERGENCE_ERROR = NL_CONVERGENCE_ERROR Defines an error related to convergence issues. integer(kind=int32), public, parameter :: DYN_INDEX_OUT_OF_RANGE = 100103 Defines an index out of range error. integer(kind=int32), public, parameter :: DYN_INVALID_INPUT_ERROR = DIFFEQ_INVALID_INPUT_ERROR Defines an error associated with an invalid input. integer(kind=int32), public, parameter :: DYN_MATRIX_SIZE_ERROR = 100100 Defines an error associated with an incorrectly sized matrix. integer(kind=int32), public, parameter :: DYN_MEMORY_ERROR = DIFFEQ_MEMORY_ALLOCATION_ERROR Defines an error associated with memory allocations. integer(kind=int32), public, parameter :: DYN_NONMONOTONIC_ARRAY_ERROR = 100104 Defines an error related to an array being nonmonotonic. integer(kind=int32), public, parameter :: DYN_NULL_POINTER_ERROR = DIFFEQ_NULL_POINTER_ERROR Defines an error associated with a null pointer. integer(kind=int32), public, parameter :: DYN_TOLERANCE_TOO_SMALL_ERROR = FS_TOLERANCE_TOO_SMALL_ERROR Defines an error related to the request of a too small tolerance \nvalue. integer(kind=int32), public, parameter :: DYN_TOO_FEW_ITERATIONS_ERROR = FS_TOO_FEW_ITERATION_ERROR Defines an error when too few iterations were allowed. integer(kind=int32), public, parameter :: DYN_UNDERDEFINED_PROBLEM_EROR = FS_UNDERDEFINED_PROBLEM_ERROR Defines an error for an underdefined problem. integer(kind=int32), public, parameter :: DYN_ZERO_VALUED_FREQUENCY_ERROR = 100101 Defines an error associated with a zero-valued frequency. Subroutines public subroutine report_array_index_out_of_bounds_error (name, var, ind, sz, err) Reports an array index-out-of-bounds error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The offending index. integer(kind=int32), intent(in) :: sz The array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_array_size_error (name, var, expected, actual, err) Reports an array size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expected The expected array size. integer(kind=int32), intent(in) :: actual The actual array size. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_constraint_count_error (name, expected, actual, err) Reports an error associated with an incorrect number of constraints. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: expected The expected number of constraints. integer(kind=int32), intent(in) :: actual The actual number of constraints. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_convergence_error (name, niter, resid, err) Reports a convergence error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: niter The actual number of iterations taken. real(kind=real64), intent(in) :: resid The current residual estimate. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_generic_counting_error (name, str1, val, str2, flag, err) A generic error reporting routine. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: str1 The first string. integer(kind=int32), intent(in) :: val The integer value. character(len=*), intent(in) :: str2 The second string. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_matrix_size_error (name, var, expect_rows, expect_cols, actual_rows, actual_cols, err) Reports a matrix size error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: expect_rows The expected number of rows. integer(kind=int32), intent(in) :: expect_cols The expected number of columns. integer(kind=int32), intent(in) :: actual_rows The actual number of rows. integer(kind=int32), intent(in) :: actual_cols The actual number of columns. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_matrix_size_mismatch_error (name, mtx1, mtx2, m1, n1, m2, n2, err) Reports a mismatch in matrix sizes. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: mtx1 The name of the first matrix. character(len=*), intent(in) :: mtx2 The name of the second matrix. integer(kind=int32), intent(in) :: m1 The number of rows in the first matrix. integer(kind=int32), intent(in) :: n1 The number of columns in the first matrix. integer(kind=int32), intent(in) :: m2 The number of rows in the second matrix. integer(kind=int32), intent(in) :: n2 The number of columns in the second matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_memory_error (name, flag, err) Reports a memory allocation error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: flag The flag returned from the allocate statement. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonmonotonic_array_error (name, var, ind, err) Reports a nonmonotonic array error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: ind The index of the occurrence of nonmonotonicity. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonsquare_mass_matrix_error (name, m, n, err) Reports an error relating to a non-square mass matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the mass matrix. integer(kind=int32), intent(in) :: n The number of columns found in the mass matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonsquare_matrix_error (name, var, m, n, err) Reports an error relating to a non-square matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var The name of the offending variable. integer(kind=int32), intent(in) :: m The number of rows found in the matrix. integer(kind=int32), intent(in) :: n The number of columns found in the matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_nonsquare_stiffness_matrix_error (name, m, n, err) Reports an error relating to a non-square stiffness matrix. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: m The number of rows found in the stiffness matrix. integer(kind=int32), intent(in) :: n The number of columns found in the stiffness matrix. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_null_forcing_routine_error (name, err) Reports a null forcing routine pointer error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_null_solver_routine_error (name, err) Reports a null solver routine error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_overconstraint_error (name, err) Reports an overconstraint error. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_zero_difference_error (name, var1, val1, var2, val2, flag, err) Reports a zero-difference between two variables where a non-zero\ndifference was expected. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. character(len=*), intent(in) :: var1 The name of the first variable. real(kind=real64), intent(in) :: val1 The value of the first variable. character(len=*), intent(in) :: var2 The name of the second variable. real(kind=real64), intent(in) :: val2 The value of the second variable. integer(kind=int32), intent(in) :: flag The error flag. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. public subroutine report_zero_valued_frequency_error (name, index, err) Reports an error associated with a zero-valued frequency value. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name The name of the routine in which the error was found. integer(kind=int32), intent(in) :: index The array index at which the zero-valued frequency was found. class(errors), intent(inout) :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution.","tags":"","loc":"module\\dynamics_error_handling.html"},{"title":"dynamics_frequency_response – DYNAMICS","text":"Uses dynamics_error_handling fstats iso_fortran_env diffeq spectrum ferror Contents Variables FRF_ACCELERANCE_MODEL FRF_RECEPTANCE_MODEL Interfaces evaluate_accelerance_frf_model evaluate_receptance_frf_model frequency_response frequency_sweep harmonic_ode modal_excite ode_excite Derived Types frf mimo_frf Functions chirp compute_modal_damping fit_frf Subroutines modal_response normalize_mode_shapes Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: FRF_ACCELERANCE_MODEL = 1 Defines an accelerance frequency response model. integer(kind=int32), public, parameter :: FRF_RECEPTANCE_MODEL = 2 Defines a receptance frequency response model. Interfaces public interface evaluate_accelerance_frf_model private pure function evaluate_accelerance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_accelerance_frf_model_array(mdl, w) result(rst) Evaluates the specified accelerance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function. public interface evaluate_receptance_frf_model private pure function evaluate_receptance_frf_model_scalar(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64) The resulting frequency response function. private pure function evaluate_receptance_frf_model_array(mdl, w) result(rst) Evaluates the specified receptance FRF model. The model is of\nthe following form. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: mdl The model parameter array. The elements of the array are stored\nas . real(kind=real64), intent(in), dimension(:) :: w The frequency value, in rad/s, at which to evaluate the model. Return Value complex(kind=real64), allocatable, dimension(:) The resulting frequency response function. public interface frequency_response Computes the frequency response functions for a system of ODE's. private function frf_modal_prop_damp(mass, stiff, alpha, beta, freq, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . real(kind=real64), intent(in), dimension(:) :: freq An M-element array of frequency values at which to evaluate the\nfrequency response functions, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function frf_modal_prop_damp_2(mass, stiff, alpha, beta, nfreq, freq1, freq2, frc, modes, modeshapes, args, err) result(rst) Computes the frequency response functions for a \nmulti-degree-of-freedom system that uses proportional damping such\nthat the damping matrix is related to the stiffness an mass\nmatrices by proportional damping coefficients and by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency, in units of rad/s. real(kind=real64), intent(in) :: freq2 The ending frequency, in units of rad/s. procedure( modal_excite ), intent(in), pointer :: frc A pointer to a routine used to compute the modal forcing \nfunction. real(kind=real64), intent(out), optional, allocatable, dimension(:) :: modes An optional N-element allocatable array that, if supplied, will\nbe used to retrieve the modal frequencies, in units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional N-by-N allocatable matrix that, if supplied, will be\nused to retrieve the N mode shapes with each vector occupying\nits own column. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices\n are not square, or if the mass and stiffness matrices are\n different sized. DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer\n is undefined. Return Value type( frf ) The resulting frequency responses. private function siso_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency response of a single-input, single-output (SISO)\nsystem. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the excitation signal. real(kind=real64), intent(in), dimension(:) :: y An N-element array containing the response signal. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size. Return Value type( frf ) The resulting frequency response function. private function mimo_freqres(x, y, fs, win, method, err) result(rst) Estimates the frequency responses of a multiple-input, multiple-output\n(MIMO) system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x An N-by-P array containing the P inputs to the system. real(kind=real64), intent(in), dimension(:,:) :: y An N-by-M array containing the M outputs from the system. real(kind=real64), intent(in) :: fs The sampling frequency, in Hz. class(window), intent(in), optional, target :: win The window to apply to the data. If nothing is supplied, no window\nis applied. integer(kind=int32), intent(in), optional :: method Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an\nH2 estimator. The default is an H1 estimator. An H1 estimator is defined as the cross-spectrum of the input and\nresponse signals divided by the energy spectral density of the input.\nAn H2 estimator is defined as the energy spectral density of the\nresponse divided by the cross-spectrum of the input and response\nsignals. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_ARRAY_SIZE_ERROR: Occurs if x and y do not have the same number\n of rows. Return Value type( mimo_frf ) The resulting frequency response functions. public interface frequency_sweep private function frf_sweep_1(fcn, freq, iv, solver, ncycles, ntransient, points, inHz, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. The amplitude and phase are determined by means of a harmonic \nprojection method. where Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the frequency points at which the \nsolution should be computed. Notice, whatever units are utilized\nfor this array are also the units of the excitation_frequency\nproperty in sys. Additionally, this array cannot contain any\nzero-valued elements as the ODE solution time for each frequency \nis determined by the period of oscillation and number of cycles. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 5. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 30. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. logical, intent(in), optional :: inHz Set to true if the units of the frequency vector are in Hz. If\nfalse, the units are assumed as rad/s. The default is false such\nthat the frequency units are assumed to be rad/s. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses. private function frf_sweep_2(fcn, nfreq, freq1, freq2, iv, solver, ncycles, ntransient, points, inHz, args, err) result(rst) Computes the frequency response of each equation of a system of\nharmonically excited ODE's by sweeping through frequency. The amplitude and phase are determined by means of a harmonic \nprojection method. where Arguments Type Intent Optional Attributes Name procedure( harmonic_ode ), intent(in), pointer :: fcn A pointer to the routine containing the ODE's to integrate. integer(kind=int32), intent(in) :: nfreq The number of frequency values to analyze. This value must be\nat least 2. real(kind=real64), intent(in) :: freq1 The starting frequency. real(kind=real64), intent(in) :: freq2 The ending frequency. real(kind=real64), intent(in), dimension(:) :: iv An N-element array containing the initial conditions for each of \nthe N ODEs. class(ode_integrator), intent(inout), optional, target :: solver An optional differential equation solver. The default solver\nis the Dormand-Prince Runge-Kutta integrator from the DIFFEQ\nlibrary. integer(kind=int32), intent(in), optional :: ncycles An optional parameter controlling the number of cycles to \nanalyze when determining the amplitude and phase of the response.\nThe default is 5. integer(kind=int32), intent(in), optional :: ntransient An optional parameter controlling how many of the initial \n\"transient\" cycles to ignore. The default is 30. integer(kind=int32), intent(in), optional :: points An optional parameter controlling how many evenly spaced \nsolution points should be considered per cycle. The default is \n1000. logical, intent(in), optional :: inHz Set to true if the units of the frequency units are in Hz. If\nfalse, the units are assumed as rad/s. The default is false such\nthat the frequency units are assumed to be rad/s. class(*), intent(inout), optional :: args An optional argument allowing for passing of data in/out of the\nfcn subroutine. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter\n is given. DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued \n frequency was supplied. Return Value type( frf ) The resulting frequency responses. interface public subroutine harmonic_ode(freq, t, x, dxdt, args) Defines a system of ODE's exposed to harmonic excitation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. real(kind=real64), intent(in) :: t The current time step value. real(kind=real64), intent(in), dimension(:) :: x The value of the solution estimate at time t. real(kind=real64), intent(out), dimension(:) :: dxdt The derivatives as computed by this routine. class(*), intent(inout), optional :: args An optional argument allowing the passing of data in/out of\nthis routine. interface public subroutine modal_excite(freq, frc, args) Defines the interface to a routine for defining the forcing\nfunction for a modal frequency analysis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: freq The excitation frequency. When used as a part of a frequency\nresponse calculation, this value will have the same units as\nthe frequency values provided to the frequency response\nroutine. complex(kind=real64), intent(out), dimension(:) :: frc An N-element array where the forcing function should be\nwritten. class(*), intent(inout), optional :: args An optional argument that can be used to communicate with\nthe outside world. interface public function ode_excite(t) result(rst) Defines the interface for a ODE excitation function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate\nthe excitation function. Return Value real(kind=real64) The result. Derived Types type, public :: frf A container for a frequency response function, or series of frequency\nresponse functions. Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:) :: responses An N-by-M matrix containing the M frequency response functions\nevaluated at each of the N frequency points. type, public :: mimo_frf A container for the frequency responses of a system of multiple \ninputs and multiple outputs (MIMO). Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: frequency An N-element array containing the frequency values at which the \nFRF is provided. The units of this array are the same as the\nunits of the frequency values passed to the routine used to \ncompute the frequency response. complex(kind=real64), public, allocatable, dimension(:,:,:) :: responses An N-by-M-by-P array containing the frequency response functions\nfor each of the M outputs corresponding to each of the P inputs. Functions public pure elemental function chirp (t, amp, span, f1Hz, f2Hz) result(rst) Evaluates a linear chirp function. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: t The value of the independent variable at which to evaluate the \nchirp. real(kind=real64), intent(in) :: amp The amplitude. real(kind=real64), intent(in) :: span The duration of the time it takes to sweep from the start \nfrequency to the end frequency. real(kind=real64), intent(in) :: f1Hz The lower excitation frequency, in Hz. real(kind=real64), intent(in) :: f2Hz The upper excitation frequency, in Hz. Return Value real(kind=real64) The value of the function at t. public pure elemental function compute_modal_damping (lambda, alpha, beta) result(rst) Computes the modal damping factors given the\nproportional damping terms and where , , and is the eigenvalue of the system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: lambda The square of the modal frequency - the eigen value. real(kind=real64), intent(in) :: alpha The mass damping factor, . real(kind=real64), intent(in) :: beta The stiffness damping factor, . Return Value real(kind=real64) The modal damping parameter. public function fit_frf (mt, n, freq, rsp, maxp, minp, init, stats, alpha, controls, settings, info, err) result(rst) Fits an experimentally obtained frequency response by model for either a\nreceptance model: Read more… Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: mt The excitation method. The options are as follows. Read more… integer(kind=int32), intent(in) :: n The model order (# of resonant modes). real(kind=real64), intent(in), dimension(:) :: freq An M-element array containing the excitation frequency values in \nunits of rad/s. complex(kind=real64), intent(in), dimension(:) :: rsp An M-element array containing the frequency response to fit. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional 3*N-element array that can be used as upper limits on \nthe parameter values. If no upper limit is requested for a particular\nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional 3*N-element array that can be used as lower limits on \nthe parameter values. If no lower limit is requested for a particalar\nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: init An optional 3 N-element array that, if supplied, provides an initial\nguess for each of the 3 N model parameters for the iterative solver.\nIf supplied, this array replaces the peak finding algorithm for\nestimating an initial guess. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional 3*N-element array that, if supplied, will be used to\nreturn statistics about the fit for each model parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence intervals.\nThe default value is 0.05 such that a 95% confidence interval is \ncalculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. class(errors), intent(inout), optional, target :: err An optional errors-based object that if provided \ncan be used to retrieve information relating to any errors \nencountered during execution. If not provided, a default \nimplementation of the errors class is used internally to provide \nerror handling. Possible errors and warning messages that may be \nencountered are as follows. Read more… Return Value real(kind=real64), allocatable, dimension(:) An array containing the model parameters stored as . Subroutines public subroutine modal_response (mass, stiff, freqs, modeshapes, err) Computes the modal frequencies and modes shapes for \nmulti-degree-of-freedom system. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: mass The N-by-N mass matrix for the system. This matrix must be\nsymmetric. real(kind=real64), intent(in), dimension(:,:) :: stiff The N-by-N stiffness matrix for the system. This matrix must\nbe symmetric. real(kind=real64), intent(out), allocatable, dimension(:) :: freqs An allocatable N-element array where the modal frequencies will\nbe returned in ascending order with units of rad/s. real(kind=real64), intent(out), optional, allocatable, dimension(:,:) :: modeshapes An optional, allocatable N-by-N matrix where the N mode shapes\nfor the system will be returned. The mode shapes are stored in\ncolumns. class(errors), intent(inout), optional, target :: err public subroutine normalize_mode_shapes (x) Normalizes mode shape vectors such that the largest magnitude\nvalue in the vector is one. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(inout), dimension(:,:) :: x The matrix of mode shape vectors with one vector per column.","tags":"","loc":"module\\dynamics_frequency_response.html"},{"title":"dynamics_geometry – DYNAMICS","text":"Uses dynamics_helper fstats ieee_arithmetic lapack iso_fortran_env Contents Interfaces assignment(=) is_parallel line matmul plane plucker_line Derived Types line plane plucker_line Functions is_point_on_line is_point_on_plane line_common_normal line_from_point_and_vector nearest_point_on_line plane_normal point_plane_projection point_to_line_distance point_to_plane_distance vector_plane_projection Subroutines do_lines_intersect Interfaces public interface assignment(=) private pure elemental subroutine plane_assign(x, y) Assigns a plane to another. Arguments Type Intent Optional Attributes Name type( plane ), intent(out) :: x The resulting plane. type( plane ), intent(in) :: y The source plane private pure elemental subroutine line_assign(x, y) Assigns a line to another. Arguments Type Intent Optional Attributes Name type( line ), intent(out) :: x The resulting line. type( line ), intent(in) :: y The source line private pure elemental subroutine pl_assign(x, y) Assigns a plucker_line to another. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( plucker_line ), intent(in) :: y The source plucker_line. private pure elemental subroutine pl_assign_line(x, y) Assigns a line to a plucker_line. Arguments Type Intent Optional Attributes Name type( plucker_line ), intent(out) :: x The resulting plucker_line. type( line ), intent(in) :: y The source line. public interface is_parallel private pure function is_parallel_vectors(x, y, tol) result(rst) Tests to see if two vectors are parallel. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the vectors are parallel; else, false. private pure function is_parallel_lines(x, y, tol) result(rst) Tests to see if two lines are parallel. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: x The first line. class( line ), intent(in) :: y The second line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the lines are parallel; else, false. private pure function is_parallel_planes(x, y, tol) result(rst) Tests to see if two planes are parallel. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: x The first plane. class( plane ), intent(in) :: y The second plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing for parallelism. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the planes are parallel; else, false. public interface line private pure function line_from_2pts(pt1, pt2) result(rst) Constructs a line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. This point will act as the initial point\nalong the line such that in the\nequation of the line . real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( line ) The resulting line. private pure function line_from_2_planes(p1, p2) result(rst) Constructs a line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function line_from_many_points(pts) result(rst) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts An N-by-3 matrix where N is at least 2, but typically much\nlarger. Return Value type( line ) The resulting line. public interface matmul private pure function pl_matmul(x, y) result(rst) Overloads the matmul routine to allow for multiplication of the\nPlücker line coordinate vector with a matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: x The N-by-6 matrix. type( plucker_line ), intent(in) :: y The plucker_line object. Return Value real(kind=real64), allocatable, dimension(:) The resulting N-element array. public interface plane private pure function plane_from_3pts(pt1, pt2, pt3) result(rst) Constructs a plane from 3 points. The 3 points must not be colinear. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. real(kind=real64), intent(in) :: pt3 (3) The third point. Return Value type( plane ) The resulting plane. private pure function plane_from_point_and_normal(pt, nrm) result(rst) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point that lies on the plane. real(kind=real64), intent(in) :: nrm (3) The normal unit vector. Return Value type( plane ) The resulting plane. private pure function plane_from_many_points(pts) result(rst) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: pts The N-by-3 matrix containing the N points to fit. N must be\nat least 3, but is typically much larger. Return Value type( plane ) The resulting plane. public interface plucker_line private pure function pl_from_2pts(pt1, pt2) result(rst) Constructs a new plucker_line from two points. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt1 (3) The first point. real(kind=real64), intent(in) :: pt2 (3) The second point. Return Value type( plucker_line ) The resulting line. private pure function pl_from_line(ln) result(rst) Constructs a new plucker_line from a line object. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln The line. Return Value type( plucker_line ) The equivalent plucker_line. private pure function pl_from_2_planes(p1, p2) result(rst) Constructs a new plucker_line from the intersection of two planes. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: p1 The first plane. class( plane ), intent(in) :: p2 The second plane. Return Value type( plucker_line ) The resulting line. NaN's are returned in the event that the\ntwo planes are parallel. private pure function pl_from_array(x, nrm) result(rst) Constructs a new plucker_line from the supplied array. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (6) A 6-element array containing the Plücker coordinates. logical, intent(in), optional :: nrm An optional input that specifies if the first three coordinates\n(the unit vector) should be normalized (true), or left as-is\n(false). The default is true such that the vector is normalized. Return Value type( plucker_line ) The resulting line. Derived Types type, public :: line Defines the parametric form of a line . Components Type Visibility Attributes Name Initial real(kind=real64), public :: r0 (3) The coordinates of the initial point . real(kind=real64), public :: v (3) The vector defining the orientation of the line. Constructor private\n\n pure\n function line_from_2pts (pt1, pt2) Constructs a line from two points. private\n\n pure\n function line_from_2_planes (p1, p2) Constructs a line from the intersection of two planes. private\n\n pure\n function line_from_many_points (pts) Constructs the line that best fits the supplied set of points in a\nleast-squares sense. Type-Bound Procedures procedure\n , public\n :: evaluate =>\n line_eval Function type, public :: plane Defines a plane as . Components Type Visibility Attributes Name Initial real(kind=real64), public :: a The x-component of the plane normal vector. real(kind=real64), public :: b The y-component of the plane normal vector. real(kind=real64), public :: c The z-component of the plane normal vector. real(kind=real64), public :: d The offset from the origin. Constructor private\n\n pure\n function plane_from_3pts (pt1, pt2, pt3) Constructs a plane from 3 points. The 3 points must not be colinear. private\n\n pure\n function plane_from_point_and_normal (pt, nrm) Constructs a plane from a point which lies on the plane, and a \nunit vector normal to the plane. private\n\n pure\n function plane_from_many_points (pts) Constructs the plane that best fits a cloud of points in a \nleast-squares sense. Type-Bound Procedures procedure\n , public\n :: flip_normal =>\n plane_flip_normal Subroutine type, public :: plucker_line Defines a line in 3D Euclidean space using Plücker coordinates. Components Type Visibility Attributes Name Initial real(kind=real64), public :: v (6) The 6-element array containing the Plücker coordinates. The\nfirst 3 elements contain the unit vector and the last 3 elements\ncontain the moment vector. Constructor private\n\n pure\n function pl_from_2pts (pt1, pt2) Constructs a new plucker_line from two points. private\n\n pure\n function pl_from_line (ln) Constructs a new plucker_line from a line object. private\n\n pure\n function pl_from_2_planes (p1, p2) Constructs a new plucker_line from the intersection of two planes. private\n\n pure\n function pl_from_array (x, nrm) Constructs a new plucker_line from the supplied array. Type-Bound Procedures procedure\n , public\n :: m =>\n pl_m Function procedure\n , public\n :: to_array =>\n pl_to_array Function procedure\n , public\n :: u =>\n pl_u Function Functions public pure function is_point_on_line (pt, ln, tol) result(rst) Tests to see if a point lies on a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the line; else, false. public pure function is_point_on_plane (pt, pln, tol) result(rst) Tests to see if a point lies on a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. real(kind=real64), intent(in), optional :: tol The tolerance to use when testing. The default\ntolerance is 10x machine epsilon. Return Value logical Returns true if the point lies on the plane; else, false. public pure function line_common_normal (ln1, ln2) result(rst) Returns the common normal line between two lines pointing from ln1 to\nln2. In the event that the two lines are parallel within the \nspecified tolerance, there exist an infinite number of common \nnormals; therefore, a line will be chosen that runs from ln1 to ln2\nwith the point at t = 0 coincident with the point at t = 0 on ln1. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. Return Value type( line ) The common normal line. The distance along this line between\nt = 0 and t = 1 defines the length of the common normal \nconnecting ln1 to ln2. In the event that ln1 and ln2 intersect,\nthe length of this line is zero. public pure function line_from_point_and_vector (pt, x, nx) result(rst) Constructs a new line from a point (defines the point where t = 0)\nand a direction vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point at which t = 0 on the line. real(kind=real64), intent(in) :: x (3) The direction vector defining the orientation of the line. logical, intent(in), optional :: nx An optional parameter that defines if x should be normalized to\na unit vector (true), or left as-is (false). The default is\ntrue such that x is normalized to a unit vector. Return Value type( line ) The resulting line. public pure function nearest_point_on_line (pt, ln) result(rst) Gets the line parameter for the point on the line nearest the \nspecified point. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The line parameteric variable defining the location of\nthe point nearest along the line. public pure function plane_normal (pln) result(rst) Returns the normal vector of a plane. Arguments Type Intent Optional Attributes Name type( plane ), intent(in) :: pln The plane. Return Value real(kind=real64), (3) The normal vector. public pure function point_plane_projection (pt, pln) result(rst) Projects a point onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane onto which to project the point. Return Value real(kind=real64), (3) The projected point. public pure function point_to_line_distance (pt, ln) result(rst) Computes the shortest distance between a point and a line. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( line ), intent(in) :: ln The line. Return Value real(kind=real64) The shortest distance between the point and line. public pure function point_to_plane_distance (pt, pln) result(rst) Computes the shortest distance between a point and a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: pt (3) The point. class( plane ), intent(in) :: pln The plane. Return Value real(kind=real64) The shortest distance between the point and plane. public pure function vector_plane_projection (x, pln) result(rst) Projects a vector onto a plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector to project. class( plane ), intent(in) :: pln The plane onto which to project the vector. Return Value real(kind=real64), (3) The projected vector. Subroutines public pure subroutine do_lines_intersect (ln1, ln2, intersect, t1, t2, tol) Tests to see if two lines intersect. Arguments Type Intent Optional Attributes Name class( line ), intent(in) :: ln1 The first line. class( line ), intent(in) :: ln2 The second line. logical, intent(out) :: intersect True if the two lines intersect within the specified tolerance;\nelse, false if they do not intersect. real(kind=real64), intent(out), optional :: t1 The parametric value associate with ln1 defining the intersection\npoint. real(kind=real64), intent(out), optional :: t2 The parametric value associate with ln2 defining the intersection\npoint. real(kind=real64), intent(in), optional :: tol The intersection tolerance. If not supplied, the default value\nis 10x machine epsilon.","tags":"","loc":"module\\dynamics_geometry.html"},{"title":"dynamics_helper – DYNAMICS","text":"Uses iso_fortran_env Contents Functions cross_product scalar_projection to_skew_symmetric vector_angle vector_projection Functions public pure function cross_product (x, y) result(rst) Computes the cross-product of a vector. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The left-hand-side argument. real(kind=real64), intent(in) :: y (3) The right-hand-side argument Return Value real(kind=real64), (3) The resulting vector. public pure function scalar_projection (x, y) result(rst) Computes the projection of vector x onto vector y. The scalar projection\nis defined such that . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64) The scalar projection of x onto y. public pure function to_skew_symmetric (x) result(rst) Converts a 3-element vector to a 3-by-3 skew-symmetric matrix. A \nskew-symmetric matrix is defined as follows. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x (3) The vector. Return Value real(kind=real64), (3,3) The resulting skew-symmetric matrix. public pure function vector_angle (x, y) result(rst) Computes the angle between two vectors. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The first vector. real(kind=real64), intent(in), dimension(size(x)) :: y The second vector. Return Value real(kind=real64) The angle, in radians. public pure function vector_projection (x, y) result(rst) Computes the vector pojection of vector x onto vector y. The vector\nprojection is defined such that Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The vector to project. real(kind=real64), intent(in), dimension(size(x)) :: y The vector onto which x should be projected. Return Value real(kind=real64), (3) The vector projection of x onto y.","tags":"","loc":"module\\dynamics_helper.html"},{"title":"dynamics_kinematics – DYNAMICS","text":"Uses dynamics_quaternions dynamics_helper dynamics_geometry dynamics_error_handling nonlin iso_fortran_env ferror Contents Variables PRISMATIC_JOINT REVOLUTE_JOINT Interfaces coordinate_system dh_forward_kinematics dh_jacobian dh_parameter_set dh_table Derived Types coordinate_system dh_parameter_set dh_table Functions dh_matrix dh_rotate_x dh_rotate_z dh_translate_x dh_translate_z identity_4 jacobian_generating_vector solve_inverse_kinematics Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: PRISMATIC_JOINT = 1 Defines a prismatic joint. integer(kind=int32), public, parameter :: REVOLUTE_JOINT = 0 Defines a revolute joint. Interfaces public interface coordinate_system private pure function define_link_csys(xim1, zim1, zi, rim1, ri) result(rst) Defines the DH coordinate system for the specified link. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: xim1 (3) The x-axis of the previous link. real(kind=real64), intent(in) :: zim1 (3) The z-axis of the previous link. This is also the axis of the\nproximal joint of the current link. real(kind=real64), intent(in) :: zi (3) The axis of the distal joint of the current link. real(kind=real64), intent(in) :: rim1 (3) The location of the proximal joint's center or home position. real(kind=real64), intent(in) :: ri (3) The location of the distal joint's center or home position. Return Value type( coordinate_system ) The resulting coordinate system. private pure function define_csys(i, j, k, o) result(rst) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The x-axis unit vector. real(kind=real64), intent(in) :: j (3) The y-axis unit vector. real(kind=real64), intent(in) :: k (3) The x-axis unit vector. real(kind=real64), intent(in), optional :: o (3) The location of the coordinate system within a reference \ncoordinate system. If not supplied, a value of (0, 0, 0) will\nbe used. Return Value type( coordinate_system ) The new coordinate_system object. public interface dh_forward_kinematics private pure function dh_forward_kinematics_2(T1, T2) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_3(T1, T2, T3) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_4(T1, T2, T3, T4) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_5(T1, T2, T3, T4, T5) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_6(T1, T2, T3, T4, T5, T6) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_7(T1, T2, T3, T4, T5, T6, T7) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_8(T1, T2, T3, T4, T5, T6, T7, T8) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: T1 (4,4) The transformation matrix for the first link nearest ground in\nthe linkage. real(kind=real64), intent(in) :: T2 (4,4) The transformation matrix for the second link in the linkage. real(kind=real64), intent(in) :: T3 (4,4) The transformation matrix for the third link in the linkage. real(kind=real64), intent(in) :: T4 (4,4) The transformation matrix for the fourth link in the linkage. real(kind=real64), intent(in) :: T5 (4,4) The transformation matrix for the fifth link in the linkage. real(kind=real64), intent(in) :: T6 (4,4) The transformation matrix for the sixth link in the linkage. real(kind=real64), intent(in) :: T7 (4,4) The transformation matrix for the seventh link in the linkage. real(kind=real64), intent(in) :: T8 (4,4) The transformation matrix for the eigth link in the linkage. Return Value real(kind=real64), (4,4) The resulting transformation matrix. private pure function dh_forward_kinematics_array(alpha, a, theta, d) result(rst) Assembles all of the individual link transformation matrices into a \nsingle transformation matrix locating the end-effector in the parent\ncoordinate system for the overall mechanism. The first entry must\nbe from the first link nearest ground. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_params(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_parameter_set ), intent(in), dimension(:) :: x The list of DH parameters. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. private pure function dh_forward_kinematics_dh_table(x) result(rst) Assembles all of the individual link transformation matrices into\na single transformation matrix locating the end-effector in the\nparent coordinate system for the overall mechanism. Arguments Type Intent Optional Attributes Name class( dh_table ), intent(in) :: x The DH table. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. public interface dh_jacobian private function dh_build_jacobian(alpha, a, theta, d, jtypes) result(rst) Builds the Jacobian matrix for a linkage given the Denavit-Hartenberg\nparameters. The first entry in each array must be from the first link\nnearest ground. The Jacobian matrix relates the joint velocities to the end-effector velocity by . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: alpha The link twist angles, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: a The link lengths as measured along the link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: theta The joint angles, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in), dimension(size(alpha)) :: d The joint offsets distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. integer(kind=int32), intent(in), dimension(size(alpha)) :: jtypes The types of each joint. Must be either REVOLUTE_JOINT or\nPRISMATIC_JOINT. The code defaults to REVOLUTE_JOINT. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting 6-by-N Jacobian matrix where N is the number of joint\nvariables (i.e. the length of the input arrays). public interface dh_parameter_set private pure function dps_init(length, twist, offset, angle) result(rst) Constructs a new dh_parameter_set object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: length The link length. real(kind=real64), intent(in) :: twist The link twist. real(kind=real64), intent(in) :: offset The link offset. real(kind=real64), intent(in) :: angle The joint angle. Return Value type( dh_parameter_set ) The new dh_parameter_set object. public interface dh_table private pure function dh_table_init(c) result(rst) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Arguments Type Intent Optional Attributes Name class( coordinate_system ), intent(in), dimension(:) :: c An N-element array containing the coordinate frames for each\nof the N links of the linkage. Return Value type( dh_table ) The resulting Denavit-Hartenberg table. Derived Types type, public :: coordinate_system Defines a 3D Cartesian coordinate system. Components Type Visibility Attributes Name Initial real(kind=real64), public :: i (3) The unit vector along the coordinate system's x-axis. real(kind=real64), public :: j (3) The unit vector along the coordinate system's y-axis. real(kind=real64), public :: k (3) The unit vector along the coordinate system's z-axis. real(kind=real64), public :: origin (3) The location of the origin of the coordinate system in the parent\ncoordinate system. Constructor private\n\n pure\n function define_link_csys (xim1, zim1, zi, rim1, ri) Defines the DH coordinate system for the specified link. private\n\n pure\n function define_csys (i, j, k, o) Defines a new coordinate_system object. It is the callers \nresponsibility to ensure that the supplied vectors are orthogonal\nto one another. type, public :: dh_parameter_set Describes a set of Denavit-Hartenberg parameters for a single joint. Components Type Visibility Attributes Name Initial real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. Constructor private\n\n pure\n function dps_init (length, twist, offset, angle) Constructs a new dh_parameter_set object. type, public :: dh_table Describes a Denavit-Hartenberg table. Components Type Visibility Attributes Name Initial type( dh_parameter_set ), public, allocatable, dimension(:) :: parameters A collection of DH parameters for each joint in the linkage. Constructor private\n\n pure\n function dh_table_init (c) Constructs a Denavit-Hartenberg table given the locations and \norientations of a linkage. Functions public pure function dh_matrix (alpha, a, theta, d) result(rst) Computes the Denavit-Hartenberg transformation matrix for the \nspecified DH parameters. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The link twist angle, in radians. This angle is the required\nrotation of the z(i-1) axis about the link's x-axis to become\nparallel with the link's z-axis. real(kind=real64), intent(in) :: a The link length as measured along the link's x-axis. real(kind=real64), intent(in) :: theta The joint angle, in radians. This angle is the required rotation\nof the z(i-1) axis about the z(i-1) axis to become parallel with\nthe link's x-axis. real(kind=real64), intent(in) :: d The joint offset distance measured as the distance between the\nx(i-1) axis and the link's x-axis along the z(i-1) axis. Return Value real(kind=real64), (4,4) The resulting 4-by-4 transformation matrix. public pure function dh_rotate_x (alpha) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. public pure function dh_rotate_z (theta) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis rotation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: theta The rotation angle, in radians. Return Value real(kind=real64), (4,4) The matrix. public pure function dh_translate_x (a) result(rst) Computes the Denavit-Hartenberg matrix for a local x-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: a The translation. Return Value real(kind=real64), (4,4) The matrix. public pure function dh_translate_z (d) result(rst) Computes the Denavit-Hartenberg matrix for a local z-axis \ntranslation. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d The translation. Return Value real(kind=real64), (4,4) The matrix. public pure function identity_4 () result(rst) Computes a 4-by-4 identity matrix. Arguments None Return Value real(kind=real64), (4,4) The resulting identity matrix. public pure function jacobian_generating_vector (d, k, R, jtype) result(rst) Computes a single Jacobian generating vector given the position vector\nof the link origin, , and the joint axis unit vector, . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: d (3) The position vector of the end-effector, , relative to the\nlink coordinate frame given in the base coordinate frame. An easy\nway to compute this vector is to extract the first 3 elements of the\n4th column of the transformation matrix: . real(kind=real64), intent(in) :: k (3) The unit vector defining the joint axis, , given in the\nbase coordinate frame. This vector can be computed most easily by\nusing the transformation matrix: and\nthen computing . real(kind=real64), intent(in) :: R (3,3) The rotation matrix defining the orientation of the link coordinate\nframe relative to the base coordinate frame. integer(kind=int32), intent(in) :: jtype The joint type. Must be either REVOLUTE_JOINT or PRISMATIC_JOINT.\nIf incorrectly specified, the code defaults to a REVOLUTE_JOINT type. Return Value real(kind=real64), (6) The resulting 6-element Jacobian generating vector. public function solve_inverse_kinematics (mdl, qo, constraints, df, slvr, ib, jfcn, qmax, qmin, args, err) result(rst) Solves the inverse kinematics problem for a linkage. An iterative\nsolution procedure is utilized. Arguments Type Intent Optional Attributes Name procedure(vecfcn), intent(in), pointer :: mdl A routine used to compute the forward kinematics for the linkage\ngiven the current joint variable estimates. real(kind=real64), intent(in), dimension(:) :: qo An M-element array containing an initial estimate of the M joint\nvariables. real(kind=real64), intent(in), target, dimension(:) :: constraints An N-element array containing the target values (constraints) for\neach of the N kinematic equations in the model. N must be at \nleast equal to M (the number of joint variables). real(kind=real64), intent(out), optional, target, dimension(:) :: df An optional N-element array that, if supplied, can be used to \nretrieve the residuals of each of the N kinematic equations. class(constrained_equation_solver), intent(inout), optional, target :: slvr An optional solver that can be used in place of the default\nLevenberg-Marquardt solver. type(iteration_behavior), intent(out), optional :: ib An optional output that can be used to gather information on the\nsolver. procedure(jacobianfcn), intent(in), optional, pointer :: jfcn A routine that can be used to provide the Jacobian matrix for\nthe linkage. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmax An optional set of upper limits on each of the joint variables.\nIf not provided, the default is the output of the 'huge' \nintrinsic function. real(kind=real64), intent(in), optional, dimension(size(qo)) :: qmin An optional set of lower limits on each of the joint variables.\nIf not provided, the default is the negative of the output of \nthe 'huge' intrinsic function. class(*), intent(inout), optional, target :: args An optional argument that can be used to communicate with mdl. class(errors), intent(inout), optional, target :: err An errors-based object that if provided can be used to retrieve \ninformation relating to any errors encountered during execution. Return Value real(kind=real64), allocatable, dimension(:) An M-element array containing the computed joint variables.","tags":"","loc":"module\\dynamics_kinematics.html"},{"title":"dynamics_linkage – DYNAMICS","text":"Uses dynamics_quaternions dynamics_helper dynamics_geometry dynamics_kinematics iso_fortran_env collections ferror dynamics_rigid_bodies Contents Interfaces binary_link serial_linkage Derived Types binary_link serial_linkage Interfaces public interface binary_link private pure function bl_init(jtype, length, twist, offset, angle, mass, inertia, cg) result(rst) Initializes a new parallel_revolute_revolute_link instance. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in), optional :: jtype The proximal joint type. This value must be either &\nREVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, \nthis parameter defaults to REVOLUTE_JOINT. real(kind=real64), intent(in), optional :: length The link length. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: twist The link twist angle. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: offset The link offset. If no value is specified, a value of 0 is used. real(kind=real64), intent(in), optional :: angle The joint angle offset. If no value is specified, a value of 0\nis used. real(kind=real64), intent(in), optional :: mass The mass of the link. If no value is specified, a value of 1 is\nused. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not specified, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the distal coordinate\nframe, expressed in the link coordinate frame. If not supplied,\nthe CG is set to (0, 0, 0) such that it is located at the center\nof the distal joint. Return Value type( binary_link ) The resulting binary_link object. public interface serial_linkage private function sl_init(lnks) result(rst) Initializes a new serial_linkage object. Arguments Type Intent Optional Attributes Name class( binary_link ), intent(in), dimension(:) :: lnks A collection of binary_link objects. The collection starts with\nthe first link and progresses to the end-effector in a \nsequential manner. Return Value type( serial_linkage ) The serial_linkage instance. Derived Types type, public, extends( rigid_body ) :: binary_link Defines a link consisting of only two joints. The coordinate system\nof this link is situated at the distal joint with it's z-axis \ncoincident with the axis of the joint. The link utilizes a\nDenavit-Hartenberg convention in order to express its geometry. Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: joint_angle The joint angle is the required rotation of the previous link's\nx-axis about the proximal joint's axis to become parallel to the\ncurrent link's x-axis. real(kind=real64), public :: joint_type The proximal joint type. This value must be either \nREVOLUTE_JOINT or PRISMATIC_JOINT. real(kind=real64), public :: link_length The link length is the distance between the proximal and distal\njoint axes as measured along the link's x-axis. real(kind=real64), public :: link_offset The link offset is the fixed distance between the previous link's\nx-axis and the current link's x-axis as measured along the\naxis of the proximal joint. real(kind=real64), public :: link_twist The link twist is the required rotation of the proximal joint \naxis about the link's x-axis to become parallel to the distal\njoint's axis. real(kind=real64), public :: mass The mass of the body. Constructor private\n\n pure\n function bl_init (jtype, length, twist, offset, angle, mass, inertia, cg) Initializes a new parallel_revolute_revolute_link instance. type, public :: serial_linkage Defines a serial linkage. Constructor private\n\n \n function sl_init (lnks) Initializes a new serial_linkage object. Type-Bound Procedures procedure\n , public\n :: forward_kinematics =>\n sl_forward_kinematics Function procedure\n , public\n :: get_link =>\n sl_get_link Function procedure\n , public\n :: get_link_count =>\n sl_get_link_count Function procedure\n , public\n :: inverse_kinematics =>\n sl_inverse_kinematics_1 Function procedure\n , public\n :: jacobian =>\n sl_jacobian Function","tags":"","loc":"module\\dynamics_linkage.html"},{"title":"dynamics_maps – DYNAMICS","text":"Uses dynamics_geometry iso_fortran_env Contents Variables POINCARE_ONE_SIDED_FROM_BACK POINCARE_ONE_SIDED_FROM_FRONT POINCARE_TWO_SIDED Functions poincare_map Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: POINCARE_ONE_SIDED_FROM_BACK = 2 A one-sided Poincare section will be computed where the algorithm\nonly retains intersection points where the trajectory approaches\nthe sectioning plane from the back (the side opposite the plane \nnormal). integer(kind=int32), public, parameter :: POINCARE_ONE_SIDED_FROM_FRONT = 1 A one-sided Poincare section will be computed where the algorithm\nonly retains intersection points where the trajectory approaches\nthe sectioning plane from the front (the side of the plane normal). integer(kind=int32), public, parameter :: POINCARE_TWO_SIDED = 0 A two-sided Poincare section will be computed. In this section, the\nalgorithm does not care whether the trajectory approaches the \nsectioning plane from the front or the back of the plane (defined\nby the plane normal). It simply returns any intersection point. Functions public pure function poincare_map (x, y, z, pln, side) result(rst) Generates a Poincare map by determining the intersections of the\nsupplied trajectory with the specified plane. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The x-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: y The y-coordinates of the trajectory. real(kind=real64), intent(in), dimension(size(x)) :: z The z-coordinates of the trajectory. class( plane ), intent(in), optional :: pln The plane to intersect. If not supplied, the x-y plane is \nutilized where z = 0. integer(kind=int32), intent(in), optional :: side An integer flag denoting which approach to use when computing\nthe section. The acceptable values are as follows. Read more… Return Value real(kind=real64), allocatable, dimension(:,:) An N-by-3 matrix containing the x, y, and z coordinates of each\nof the N intersection points in the first, second, and third\ncolumns respectively.","tags":"","loc":"module\\dynamics_maps.html"},{"title":"dynamics_quaternions – DYNAMICS","text":"Uses iso_fortran_env Contents Interfaces abs aimag assignment(=) conjg dot_product exp log operator(*) operator(**) operator(+) operator(-) operator(/) quaternion real Derived Types quaternion Functions inverse Interfaces public interface abs private pure elemental function quat_abs(q) result(rst) Computes the magnitude of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The magnitude of the quaternion. public interface aimag private pure function quat_aimag(q) result(rst) Returns the imaginary component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64), dimension(3) The imaginary component as a vector. public interface assignment(=) private pure elemental subroutine quat_assign(x, y) Assigns a quaternion to another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. type( quaternion ), intent(in) :: y The source quaternion. private pure subroutine quat_assign_vec4(x, y) Assigns a 4-element vector to a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(out) :: x The resulting quaternion. real(kind=real64), intent(in), dimension(4) :: y The source vector. public interface conjg private pure elemental function quat_conjg(q) result(rst) Computes the conjugate of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The conjugate of the quaternion. public interface dot_product private pure elemental function quat_dot_prd(x, y) result(rst) Computes the dot product of two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value real(kind=real64) The dot product. public interface exp private pure elemental function quat_exp(q) result(rst) Evaluates the exponential function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion. public interface log private pure elemental function quat_log(q) result(rst) Evalautes the natural logarithm function for a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The resulting quaternion. public interface operator(*) private pure elemental function quat_scalar_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function scalar_quat_mult(x, y) result(rst) Multiplies a quaternion with a scalar. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x The scalar. type( quaternion ), intent(in) :: y The quaternion. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_multiply(x, y) result(rst) Multiplies two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure function quat_vec3_mult(x, y) result(rst) Multiplies a quaternion with a 3-element vector. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in), dimension(3) :: y The vector. Return Value type( quaternion ) The resulting quaternion. public interface operator(**) private pure elemental function quat_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. real(kind=real64), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_int_pwr(q, exponent) result(rst) Computes the result of a quaternion raised to an exponent. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion base. integer(kind=int32), intent(in) :: exponent The exponent. Return Value type( quaternion ) The resulting quaternion. public interface operator(+) private pure elemental function quat_add(x, y) result(rst) Adds two quaternions together. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. public interface operator(-) private pure elemental function quat_subtract(x, y) result(rst) Subtracts two quaternions. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_negate(x) result(rst) Negates a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. Return Value type( quaternion ) The resulting quaternion. public interface operator(/) private pure elemental function quat_scalar_div(x, y) result(rst) Divides a quaternion by a scalar. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The quaternion. real(kind=real64), intent(in) :: y The scalar. Return Value type( quaternion ) The resulting quaternion. private pure elemental function quat_divide(x, y) result(rst) Divides a quaternion by another. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: x The left-hand-side argument. type( quaternion ), intent(in) :: y The right-hand-side argument. Return Value type( quaternion ) The resulting quaternion. public interface quaternion private pure function quat_init_array(x) result(rst) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(4) :: x The array from which to initialize the quaternion stored in the\norder [w, x, y, z]. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_angle_axis(angle, axis) result(rst) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. real(kind=real64), intent(in), dimension(3) :: axis A 3-element vector defining the axis about which the rotation\noccurrs. Return Value type( quaternion ) The resulting quaternion. private pure function quat_init_mtx(r) result(rst) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(3, 3) :: r The rotation matrix. Return Value type( quaternion ) The resulting quaternion. public interface real private pure elemental function quat_real(q) result(rst) Returns the real component of the quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value real(kind=real64) The real component. Derived Types type, public :: quaternion Defines a quaternion of the form: Components Type Visibility Attributes Name Initial real(kind=real64), public :: w The real component of the quaternion. real(kind=real64), public :: x The first element in the imaginary component of the quaternion. real(kind=real64), public :: y The second element in the imaginary component of the quaternion. real(kind=real64), public :: z The third element in the imaginary component of the quaternion. Constructor private\n\n pure\n function quat_init_array (x) Constructs a quaternion from a 4-element array stored such that\n[w, x, y, z]. private\n\n pure\n function quat_init_angle_axis (angle, axis) Constructs a quaternion given an axis and the angle of rotation about\nthe axis. private\n\n pure\n function quat_init_mtx (r) Constructs a quaternion from a 3-by-3 rotation matrix using the \nStanley method. Type-Bound Procedures procedure\n , public\n :: normalize =>\n quat_normalize Subroutine procedure\n , public\n :: to_angle_axis =>\n quat_to_angle_axis Subroutine procedure\n , public\n :: to_array =>\n quat_to_vec4 Function procedure\n , public\n :: to_matrix =>\n quat_to_matrix Function procedure\n , public\n :: to_roll_pitch_yaw =>\n quat_to_rpy Subroutine Functions public pure elemental function inverse (q) result(rst) Computes the inverse of a quaternion. Arguments Type Intent Optional Attributes Name type( quaternion ), intent(in) :: q The quaternion. Return Value type( quaternion ) The inverse of the supplied quaternion.","tags":"","loc":"module\\dynamics_quaternions.html"},{"title":"dynamics_rigid_bodies – DYNAMICS","text":"Uses iso_fortran_env Contents Interfaces rigid_body Derived Types rigid_body Subroutines initialize_rigid_body Interfaces public interface rigid_body private pure function rb_init(m, inertia, cg) result(rst) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0). Return Value type( rigid_body ) The rigid_body object. Derived Types type, public :: rigid_body Defines a rigid body. Components Type Visibility Attributes Name Initial real(kind=real64), public :: cg (3) The x-y-z location of the CG relative to the body coordinate \nframe. real(kind=real64), public :: inertia (3,3) The 3-by-3 inertia tensor as measured about the CG of the body. real(kind=real64), public :: mass The mass of the body. Constructor private\n\n pure\n function rb_init (m, inertia, cg) Initializes a rigid_body object. Subroutines public pure subroutine initialize_rigid_body (bdy, m, inertia, cg) Initializes a rigid_body object. Arguments Type Intent Optional Attributes Name class( rigid_body ), intent(inout) :: bdy The rigid_body object. real(kind=real64), intent(in), optional :: m The mass of the body. If no mass is specified, a value of 1 is used. real(kind=real64), intent(in), optional :: inertia (3,3) The 3-by-3 inertia tensor. If not supplied, an identity matrix\nis used. real(kind=real64), intent(in), optional :: cg (3) The x-y-z location of the CG relative to the body coordinate frame.\nIf not supplied, the CG is set to (0, 0, 0).","tags":"","loc":"module\\dynamics_rigid_bodies.html"},{"title":"dynamics_rotation – DYNAMICS","text":"Uses dynamics_helper iso_fortran_env Contents Interfaces rotate Functions acceleration_transform rotate_x rotate_y rotate_z velocity_transform Subroutines to_angle_axis Interfaces public interface rotate private pure function rotate_general_1(i, j, k, Ip, Jp, Kp) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. real(kind=real64), intent(in) :: Ip (3) The parent coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: Jp (3) The parent coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: Kp (3) The parent coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. private pure function rotate_general_2(i, j, k) result(rst) Constructs a rotation matrix when the orientation of the coordinate\nframe of interest is known relative to the parent coordinate frame. The matrix is of the following form. The parent coordinate frame is assumed to be as follows. This routine does not check for orthogonallity or unit vector length;\ntherefore, to ensure correct results it is the callers responsibility\nto ensure each vector is of unit length and that the unit vectors\nare properly orthogonal. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: i (3) The rotated coordinate frame x-axis unit vector. real(kind=real64), intent(in) :: j (3) The rotated coordinate frame y-axis unit vector. real(kind=real64), intent(in) :: k (3) The rotated coordinate frame z-axis unit vector. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. Functions public pure function acceleration_transform (alpha, omega, a, x) result(rst) Computes the acceleration transformation matrix relating the\nposition of a point expressed in a rotating and translating body\nrelative to its parent frame. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: alpha (3) The angular acceleration vector. real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: a (3) The translational acceleration vector describing the acceleration\nof the body in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. public pure function rotate_x (angle) result(rst) Constructs the rotation matrix describing a rotation about an\nx-axis such that . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. public pure function rotate_y (angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. public pure function rotate_z (angle) result(rst) Constructs the rotation matrix describing a rotation about a y-axis\nsuch that . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: angle The rotation angle, in radians. Return Value real(kind=real64), (3,3) The resulting 3-by-3 matrix. public pure function velocity_transform (omega, v, x) result(rst) Computes the velocity transformation matrix relating the position\nof a point expressed in a rotating and translating body relative to\nits parent frame. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: omega (3) The angular velocity vector. real(kind=real64), intent(in) :: v (3) The translation velocity vector describing the velocity of the\nbody in its parent coordinate frame. real(kind=real64), intent(in) :: x (3) The position vector of the body in its parent coordinate frame. Return Value real(kind=real64), (4,4) The 4-by-4 transformation matrix. Subroutines public pure subroutine to_angle_axis (r, angle, axis) Extracts the equivalent rotation angle and axis of rotation given a\n3-by-3 rotation matrix. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: r (3,3) The 3-by-3 rotation matrix. real(kind=real64), intent(out) :: angle The rotation angle. real(kind=real64), intent(out) :: axis (3) The axis of rotation.","tags":"","loc":"module\\dynamics_rotation.html"},{"title":"dynamics_stability – DYNAMICS","text":"Uses linalg ferror dynamics_error_handling iso_fortran_env Contents Variables HYPERBOLIC_FIXED_POINT_SADDLE HYPERBOLIC_FIXED_POINT_SINK HYPERBOLIC_FIXED_POINT_SOURCE NONHYPERBOLIC_FIXED_POINT_CENTER NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE NONHYPERBOLIC_FIXED_POINT_UNSTABLE Functions determine_local_stability Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: HYPERBOLIC_FIXED_POINT_SADDLE = 102 Describes a hyperbolic fixed point where all of the eigenvalues of\nthe dynamics matrix have a nonzero real part but one or more of the\neigenvalues has a positive-valued real part. integer(kind=int32), public, parameter :: HYPERBOLIC_FIXED_POINT_SINK = 100 Describes a hyperbolic fixed point where all of the eigenvalues of\nthe dynamics matrix have a nonzero real part and all real parts are\nnegative-valued. This point is considered stable. integer(kind=int32), public, parameter :: HYPERBOLIC_FIXED_POINT_SOURCE = 101 Describes a hyperbolic fixed point where all of the eigenvalues of\nthe dynamics matrix have a nonzero real part and the real\npart is positive-valued for each. This point is considered unstable. integer(kind=int32), public, parameter :: NONHYPERBOLIC_FIXED_POINT_CENTER = 105 Describes a nonhyperbolic fixed point where all of the eigenvalues\nof the dynamics matrix are purely imaginary and nonzero. This point\nis considered stable. integer(kind=int32), public, parameter :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE = 104 Describes a nonhyperbolic fixed point where some of the eigenvalues \nof the dynamics matrix have negative real parts and the remaining\neigenvalues all have zero-valued real parts. integer(kind=int32), public, parameter :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE = 103 Describes a nonhyperbolic fixed point where one or more of the \neigenvalues of the dynamics matrix have a positive-valued real part. Functions public function determine_local_stability (a, ev, err) result(rst) Determines the nature of stability/unstability near the point at which\nthe dynamics matrix was computed. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:,:) :: a An N-by-N matrix containing the 'A' matrix, also known as the\ndynamics matrix. complex(kind=real64), intent(out), optional, dimension(:) :: ev An optional N-element array that, if supplied, will be filled with \nthe eigenvalues of the matrix A. class(errors), intent(inout), optional, target :: err An error handler object. Return Value integer(kind=int32) Describe the output constants","tags":"","loc":"module\\dynamics_stability.html"},{"title":"dynamics_structural – DYNAMICS","text":"Uses linalg dynamics_error_handling iso_fortran_env dynamics_rotation ferror Contents Variables DYN_FOUR_POINT_INTEGRATION_RULE DYN_ONE_POINT_INTEGRATION_RULE DYN_THREE_POINT_INTEGRATION_RULE DYN_TWO_POINT_INTEGRATION_RULE Interfaces apply_boundary_conditions Derived Types beam_element_2d beam_element_3d element line_element material node point Functions create_connectivity_matrix restore_constrained_values shape_function_derivative shape_function_second_derivative Subroutines apply_displacement_constraint Variables Type Visibility Attributes Name Initial integer(kind=int32), public, parameter :: DYN_FOUR_POINT_INTEGRATION_RULE = 4 Defines a four-point integration rule. integer(kind=int32), public, parameter :: DYN_ONE_POINT_INTEGRATION_RULE = 1 Defines a single-point integration rule. integer(kind=int32), public, parameter :: DYN_THREE_POINT_INTEGRATION_RULE = 3 Defines a three-point integration rule. integer(kind=int32), public, parameter :: DYN_TWO_POINT_INTEGRATION_RULE = 2 Defines a two-point integration rule. Interfaces public interface apply_boundary_conditions private function apply_boundary_conditions_mtx(gdof, x, err) result(rst) Applies boundary conditions to a matrix by removal of the appropriate\nrows and columns. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:,:) :: x The matrix to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The altered matrix. private function apply_boundary_conditions_vec(gdof, x, err) result(rst) Applies boundary conditions to a vector by removal of the appropriate\nitems. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The vector to constrain. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector. Derived Types type, public, extends( line_element ) :: beam_element_2d Defines a two-dimensional Bernoulli-Euler beam element. Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. real(kind=real64), public :: moment_of_inertia The beam moment of inertia (second moment of area). type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). Type-Bound Procedures procedure\n , public\n :: constitutive_matrix =>\n b2d_constitutive_matrix Function procedure\n , public\n :: evaluate_shape_function =>\n b2d_shape_function Function procedure\n , public\n :: external_force_vector =>\n le_ext_force_vector Function procedure\n , public\n :: get_dimensionality =>\n b2d_dimensionality Function procedure\n , public\n :: get_dof_per_node =>\n b2d_dof_per_node Function procedure\n , public\n :: get_node =>\n b2d_get_node Function procedure\n , public\n :: get_node_count =>\n b2d_get_node_count Function procedure\n , public\n :: get_terminal_nodes =>\n b2d_terminal_nodes Subroutine procedure\n , public\n :: jacobian =>\n b2d_jacobian Function procedure\n , public\n :: length =>\n le_length Function procedure\n , public\n :: mass_matrix =>\n b2d_mass_matrix Function procedure\n , public\n :: rotation_matrix =>\n b2d_rotation_matrix Function procedure\n , public\n :: shape_function_matrix =>\n b2d_shape_function_matrix_2d Function procedure\n , public\n :: stiffness_matrix =>\n b2d_stiffness_matrix Function procedure\n , public\n :: strain_displacement_matrix =>\n b2d_strain_disp_matrix_2d Function type, public, extends( line_element ) :: beam_element_3d Defines a three-dimensional Bernoulli-Euler beam element. Components Type Visibility Attributes Name Initial real(kind=real64), public :: Ixx The beam moment of inertia about the element x-axis. real(kind=real64), public :: Iyy The beam moment of inertia about the element y-axis. real(kind=real64), public :: Izz The beam moment of inertia about the element z-axis. real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. type( node ), public :: node_1 The first node of the element (s = -1). type( node ), public :: node_2 The second node of the element (s = 1). type( point ), public :: orientation_point A point used to determine the orientation of the beam in 3D\nspace. The orientation point is measured relative to the first\nnode in the element. Specifically, the element z axis is assumed\nto be defined by the location of this point relative to the\nlocation of node 1. Type-Bound Procedures procedure\n , public\n :: constitutive_matrix =>\n b3d_constitutive_matrix Function procedure\n , public\n :: evaluate_shape_function =>\n b3d_shape_function Function procedure\n , public\n :: external_force_vector =>\n le_ext_force_vector Function procedure\n , public\n :: get_dimensionality =>\n b3d_dimensionality Function procedure\n , public\n :: get_dof_per_node =>\n b3d_dof_per_node Function procedure\n , public\n :: get_node =>\n b3d_get_node Function procedure\n , public\n :: get_node_count =>\n b3d_get_node_count Function procedure\n , public\n :: get_terminal_nodes =>\n b3d_terminal_nodes Subroutine procedure\n , public\n :: jacobian =>\n b3d_jacobian Function procedure\n , public\n :: length =>\n le_length Function procedure\n , public\n :: mass_matrix =>\n b3d_mass_matrix Function procedure\n , public\n :: rotation_matrix =>\n b3d_rotation_matrix Function procedure\n , public\n :: shape_function_matrix =>\n b3d_shape_function_matrix_3d Function procedure\n , public\n :: stiffness_matrix =>\n b3d_stiffness_matrix Function procedure\n , public\n :: strain_displacement_matrix =>\n b3d_strain_disp_matrix_3d Function type, public :: element Defines an element. Components Type Visibility Attributes Name Initial type( material ), public :: material The material. Type-Bound Procedures procedure\n(element_const_matrix_function) , public\n, pass :: constitutive_matrix procedure\n(element_shape_function) , public\n, pass :: evaluate_shape_function procedure\n , public\n :: external_force_vector =>\n e_ext_force_vector Function procedure\n(element_query) , public\n, pass :: get_dimensionality procedure\n(element_query) , public\n, pass :: get_dof_per_node procedure\n(element_get_node) , public\n, pass :: get_node procedure\n(element_query) , public\n, pass :: get_node_count procedure\n(element_matrix_function) , public\n, pass :: jacobian procedure\n , public\n :: mass_matrix =>\n e_mass_matrix Function procedure\n(element_matrix_function) , public\n, pass :: shape_function_matrix procedure\n , public\n :: stiffness_matrix =>\n e_stiffness_matrix Function procedure\n(element_matrix_function) , public\n, pass :: strain_displacement_matrix type, public, extends( element ) :: line_element Defines a line element type. Components Type Visibility Attributes Name Initial real(kind=real64), public :: area The element cross-sectional area. type( material ), public :: material The material. Type-Bound Procedures procedure\n(element_const_matrix_function) , public\n, pass :: constitutive_matrix procedure\n(element_shape_function) , public\n, pass :: evaluate_shape_function procedure\n , public\n :: external_force_vector =>\n le_ext_force_vector Function procedure\n(element_query) , public\n, pass :: get_dimensionality procedure\n(element_query) , public\n, pass :: get_dof_per_node procedure\n(element_get_node) , public\n, pass :: get_node procedure\n(element_query) , public\n, pass :: get_node_count procedure\n(line_element_get_terminal) , public\n, pass :: get_terminal_nodes procedure\n(element_matrix_function) , public\n, pass :: jacobian procedure\n , public\n :: length =>\n le_length Function procedure\n , public\n :: mass_matrix =>\n le_mass_matrix Function procedure\n(line_element_const_matrix_function) , public\n, pass :: rotation_matrix procedure\n(element_matrix_function) , public\n, pass :: shape_function_matrix procedure\n , public\n :: stiffness_matrix =>\n le_stiffness_matrix Function procedure\n(element_matrix_function) , public\n, pass :: strain_displacement_matrix type, public :: material Defines a linear-elastic-isotropic material. Components Type Visibility Attributes Name Initial real(kind=real64), public :: density The density of the material. real(kind=real64), public :: modulus The modulus of elasticity of the material. real(kind=real64), public :: poissons_ratio The Poisson's ratio of the material. type, public, extends( point ) :: node Defines a node. Components Type Visibility Attributes Name Initial integer(kind=int32), public :: dof The number of degrees of freeedom associated with this node. integer(kind=int32), public :: index The global index of the node. real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate. type, public :: point Defines a point in 3D, Cartesian space. Components Type Visibility Attributes Name Initial real(kind=real64), public :: x The x-coordinate. real(kind=real64), public :: y The y-coordinate. real(kind=real64), public :: z The z-coordinate. Functions public function create_connectivity_matrix (gdof, e, nodes, err) result(rst) Creates a connectivity matrix for the element. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: gdof The number of global degrees of freedom. class( element ), intent(in) :: e The element. class( node ), intent(in), dimension(:) :: nodes The global node list. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:,:) The resulting matrix. public function restore_constrained_values (gdof, x, err) result(rst) Restores the constrained degrees-of-freedom from the boundary conditions\napplied by apply_boundary_conditions. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(inout), dimension(:) :: gdof An array of the global degrees of freedom to restrain. The array\nis sorted into ascending order on output. real(kind=real64), intent(in), dimension(:) :: x The constrained vector. class(errors), intent(inout), optional, target :: err An optional error handling object. Return Value real(kind=real64), allocatable, dimension(:) The altered vector. public pure function shape_function_derivative (index, elem, s, i) result(rst) Computes the derivative of the shape function with respect to the natural\ncoordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. public pure function shape_function_second_derivative (index, elem, s, i) result(rst) Computes the second derivative of the shape function with respect to the\nnatural coordinate specified. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: index The index of the shape function to evaluate. class( element ), intent(in) :: elem The element object. real(kind=real64), intent(in), dimension(:) :: s The natural coordinate at which to evaluate the derivative. integer(kind=int32), intent(in) :: i The index of the natural coordinate to with which the derivative is\nto be computed. Return Value real(kind=real64) The result. Subroutines public subroutine apply_displacement_constraint (dof, val, k, f) Applies a displacement constraint to the specified degree of freedom. Arguments Type Intent Optional Attributes Name integer(kind=int32), intent(in) :: dof The global degree-of-freedom to which the constraint should be\napplied. real(kind=real64), intent(in) :: val The value of the displacement constraint. real(kind=real64), intent(inout), dimension(:,:) :: k The stiffness matrix to which the constraint should be applied. real(kind=real64), intent(inout), dimension(:) :: f The external force vector to which the constraint should be applied.","tags":"","loc":"module\\dynamics_structural.html"},{"title":"dynamics_system_id – DYNAMICS","text":"Uses dynamics_error_handling fstats iso_fortran_env diffeq ferror Contents Interfaces constraint_equations siso_model_fit_least_squares Derived Types dynamic_system_measurement model_information Interfaces interface public subroutine constraint_equations(xg, fg, xc, p, fc, args) An interface to a set of routines for defining constraint \nequations to the fitting process. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: xg An N-element array containing the N independent variable\nvalues for the N differential equation solution points. real(kind=real64), intent(in), dimension(:) :: fg An N-element array containing the N differential equation\nsolution points. real(kind=real64), intent(in), dimension(:) :: xc An M-element array containing the M independent variable\nvalues for the M constraint equations. real(kind=real64), intent(in), dimension(:) :: p An array containing the model parameters. real(kind=real64), intent(out), dimension(:) :: fc An M-element array where the values of the constraint \nequations should be written. class(*), intent(inout), optional :: args An optional argument that can be used to pass data in/out\nof this routine. public interface siso_model_fit_least_squares private subroutine siso_model_fit_least_squares_1(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:) :: ic The initial condition vector for the equations in fcn. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object. private subroutine siso_model_fit_least_squares_2(fcn, x, ic, p, integrator, ind, maxp, minp, stats, alpha, controls, settings, info, status, cov, xc, yc, constraints, weights, args, err) Attempts to fit a model of a single-intput, single-output (SISO) dynamic \nsystem by means of an iterative least-squares solver. The algorithm\ncomputes the solution to the differential equations numerically, and\ncompares the output to the known solution via a Levenberg-Marquardt\nleast-squares solver. Arguments Type Intent Optional Attributes Name procedure(ode), intent(in), pointer :: fcn The routine containing the ODE's being fit. To communicate \nmodel parameters and other relevant information, an instance of the\n[[model_information]] type is passed to the optional argument of this\nroutine. Use the \"select type\" construct to access this information. class( dynamic_system_measurement ), intent(in), dimension(:) :: x An M-element array of arrays with each array containing the measured\ninput and output of the system being identified. real(kind=real64), intent(in), dimension(:,:) :: ic An M-by-NEQN matrix of initial condition vectors for the NEQN \nequations in fcn, one set for each of the M sets of data in x. real(kind=real64), intent(inout), dimension(:) :: p An N-element array containing an initial guess at the parameters. On output, the computed model parameters. class(ode_integrator), intent(inout), optional, target :: integrator The integrator to use when solving the system equations. If not\nsupplied, the default integrator will be used. The default \nintegrator is a Runge-Kutta integrator (Dormand-Prince). integer(kind=int32), intent(in), optional :: ind The index of the ODE in fcn providing the output to fit. If\nno value is supplied, a value of 1 will be utilized. real(kind=real64), intent(in), optional, dimension(:) :: maxp An optional N-element array that can be used as upper limits on the \nparameter values. If no upper limit is requested for a particular \nparameter, utilize a very large value. The internal default is to \nutilize huge() as a value. real(kind=real64), intent(in), optional, dimension(:) :: minp An optional N-element array that can be used as lower limits on the \nparameter values. If no lower limit is requested for a particalar \nparameter, utilize a very large magnitude, but negative, value. The \ninternal default is to utilize -huge() as a value. type(regression_statistics), intent(out), optional, dimension(:) :: stats An optional N-element array that, if supplied, will be used to \nreturn statistics about the fit for each parameter. real(kind=real64), intent(in), optional :: alpha The significance level at which to evaluate the confidence \nintervals. The default value is 0.05 such that a 95% confidence \ninterval is calculated. type(iteration_controls), intent(in), optional :: controls An optional input providing custom iteration controls. type(lm_solver_options), intent(in), optional :: settings An optional input providing custom settings for the solver. type(convergence_info), intent(out), optional :: info An optional output that can be used to gain information about the \niterative solution and the nature of the convergence. procedure(iteration_update), intent(in), optional, pointer :: status An optional pointer to a routine that can be used to extract \niteration information. real(kind=real64), intent(out), optional, dimension(:,:) :: cov An optional N-by-N matrix that, if supplied, will be used to return \nthe covariance matrix. real(kind=real64), intent(in), optional, dimension(:) :: xc An optional NC-element array containing the values of the independent \nvariable at which the constraint equations are defined. real(kind=real64), intent(in), optional, dimension(:) :: yc An optional NC-element array containing the constraint function \nvalues at xc. procedure( constraint_equations ), optional, pointer :: constraints An optional input, that must be utilized with the xc and yc inputs,\nbut allows for the implementation of additional constraints on the\nsolution outside of the differential equations being fitted. An\nexample usage would be an additional set of quasi-static tests that\ncould help identify a stiffness term, for instance. Other uses of\ncourse can be imagined. real(kind=real64), intent(in), optional, dimension(:) :: weights An optional array containing weighting factors for every equation. class(*), intent(inout), optional, target :: args User-defined information to pass along to fcn. These arguments,\nif supplied, will be passed through to fcn by means of the\n[[model_information]] type. class(errors), intent(inout), optional, target :: err An error handling object. Derived Types type, public :: dynamic_system_measurement A container of a single measurement data set. Components Type Visibility Attributes Name Initial real(kind=real64), public, allocatable, dimension(:) :: input The input data. real(kind=real64), public, allocatable, dimension(:) :: output The output data. real(kind=real64), public, allocatable, dimension(:) :: t The time points at which the measurements were taken. type, public :: model_information A container for model information. Components Type Visibility Attributes Name Initial class(base_interpolator), public, pointer :: excitation An interpolation object allowing sampling of the excitation \nfunction. real(kind=real64), public, allocatable, dimension(:) :: model An array containing the model parameters. class(*), public, pointer :: user_info Information the user has passed along.","tags":"","loc":"module\\dynamics_system_id.html"},{"title":"dynamics_vibrations – DYNAMICS","text":"Uses ieee_arithmetic peaks iso_fortran_env Contents Functions damping_from_fractional_overshoot damping_from_log_decrement estimate_bandwidth evaluate_step_response find_settling_amplitude logarithmic_decrement q_factor rise_time Subroutines find_free_response_properties Functions public pure function damping_from_fractional_overshoot (x) result(rst) Employs the method of fractional overshoot to estimate the damping ratio\nfrom the response of a system to a step input. This method is useful\nfor cases where the damping ratio is between approximately 0.5 to 0.8.\nIn such range, the logarithmic decrement approach becomes less precise. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The estimated damping ratio. public pure elemental function damping_from_log_decrement (delta) result(rst) Computes the damping ratio from the logarithmic decrement .\nThe damping ratio is related to the logarithmic decrement by the \nfollowing relationship. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: delta The logarithmic decrement. Return Value real(kind=real64) The damping ratio. public pure elemental function estimate_bandwidth (fn, zeta) result(rst) Estimates the bandwidth of the resonant mode of a vibratory system.\nThe bandwidth is the width of the range of frequencies for which the\nenergy is at least half its peak value and is computed as . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: fn The resonant frequency. The units are not important; however, \nthe units of the output will be the same as the units of this\nparameter. real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The bandwidth. public pure elemental function evaluate_step_response (wn, zeta, xs, t) result(rst) Evaluates the response of an underdamped single-degree-of-freedom, \nlinear system to a step function of amplitude . Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio. real(kind=real64), intent(in) :: xs The amplitude of the step input. real(kind=real64), intent(in) :: t The point in time at which to evaluate the response (units = s). Return Value real(kind=real64) The step response. public pure function find_settling_amplitude (x) result(rst) Estimates the settling amplitude for a step response. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: x The step response of the system. Return Value real(kind=real64) The settling amplitude of the step response. public pure elemental function logarithmic_decrement (x1, x2, n) result(rst) Computes the logarithmic decrement given the value of two successive\npeaks in the time history of the free vibratory response of the system.\nThe logarithmic decrement is calculated as follows. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: x1 The amplitude of the first peak. real(kind=real64), intent(in) :: x2 The amplitude of the second peak that occurs N periods after the\nfirst. integer(kind=int32), intent(in) :: n The number of periods of oscillation seperating the two peaks. Return Value real(kind=real64) The logarithmic decrement . public pure elemental function q_factor (zeta) result(rst) Estimates the Q-factor for a vibratory system. The Q-factor is computed . Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: zeta The damping ratio. Return Value real(kind=real64) The Q-factor. public pure elemental function rise_time (wn, zeta) result(rst) Computes the rise time for an underdamped, second-order system. The\nrise time is the time it takes for the system response to go from 0%\nto 100% of its final value and is given by the following relationship. Read more… Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in) :: wn The resonant frequency of the system, in rad/s. real(kind=real64), intent(in) :: zeta The damping ratio of the system. This value must be less than 1\nas this relationship is only valid for an underdamped system. Return Value real(kind=real64) The rise time, in units of seconds. Subroutines public subroutine find_free_response_properties (t, x, delta, fn, x1, x2, t1, t2, s, n) Given a free-response time history, this routine attempts to find the \nlogarithmic decrement and resonant frequency of a vibratory system. The\nlogarithmic decrement is estimated by finding successive peaks by\nmeans of peak detection. Arguments Type Intent Optional Attributes Name real(kind=real64), intent(in), dimension(:) :: t An N-element array containing the values in time real(kind=real64), intent(in), dimension(:) :: x An N-element array containing the response sampled at the time points\ngiven in t. real(kind=real64), intent(out) :: delta The logarithmic decrement estimate. If sufficient peaks cannot be\nlocated, the routine returns NaN. real(kind=real64), intent(out) :: fn The damped resonant frequency in units of Hz, assuming that the\ntime values are in seconds. If the time units are not in seconds,\nthe units will be cycle/unit time with unit time being the units\nin which t is supplied. If sufficient peaks cannot be located, the \nroutine returns NaN. real(kind=real64), intent(out), optional :: x1 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the first peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: x2 An optional parameter that, if provided, allows for the routine to\nreturn the amplitude of the second peak. If sufficient peaks cannot \nbe located, the routine returns NaN. real(kind=real64), intent(out), optional :: t1 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the first peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(out), optional :: t2 An optional parameter that, if provided, allows for the routine to\nreturn the time at which the second peak was located. If sufficient\npeaks cannot be located, the routine returns NaN. real(kind=real64), intent(in), optional :: s An optional input that, if provided, allows for control of the \nsensitivity of the peak detection algorithm. The default is 0.1%\nof the peak-peak amplitude of the signal. integer(kind=int32), intent(in), optional :: n An optional input that, if provided, determines the number of \nperiods to allow between peak selection for the logarithmic \ndecrement calculation. The default is 1.","tags":"","loc":"module\\dynamics_vibrations.html"},{"title":"dynamics.f90 – DYNAMICS","text":"Contents Modules dynamics Source Code dynamics.f90 Source Code module dynamics use dynamics_frequency_response use dynamics_rotation use dynamics_structural use dynamics_kinematics use dynamics_vibrations use dynamics_helper use dynamics_stability use dynamics_controls use dynamics_system_id use dynamics_linkage use dynamics_geometry use dynamics_quaternions implicit none private ! DYNAMICS_FREQUENCY_RESPONSE public :: ode_excite public :: modal_excite public :: harmonic_ode public :: frf public :: mimo_frf public :: chirp public :: frequency_response public :: frequency_sweep public :: compute_modal_damping public :: modal_response public :: normalize_mode_shapes public :: evaluate_accelerance_frf_model public :: evaluate_receptance_frf_model public :: fit_frf public :: FRF_ACCELERANCE_MODEL public :: FRF_RECEPTANCE_MODEL public :: regression_statistics public :: iteration_controls public :: lm_solver_options public :: convergence_info ! DYNAMICS_ROTATION public :: rotate_x public :: rotate_y public :: rotate_z public :: rotate public :: acceleration_transform public :: velocity_transform public :: to_angle_axis ! DYNAMICS_STRUCTURAL public :: DYN_ONE_POINT_INTEGRATION_RULE public :: DYN_TWO_POINT_INTEGRATION_RULE public :: DYN_THREE_POINT_INTEGRATION_RULE public :: DYN_FOUR_POINT_INTEGRATION_RULE public :: node public :: material public :: element public :: line_element public :: beam_element_2d public :: shape_function_derivative public :: shape_function_second_derivative public :: create_connectivity_matrix public :: apply_boundary_conditions public :: apply_displacement_constraint public :: restore_constrained_values public :: point public :: beam_element_3d ! DYNAMICS_KINEMATICS public :: identity_4 public :: dh_rotate_x public :: dh_rotate_z public :: dh_translate_x public :: dh_translate_z public :: dh_matrix public :: dh_forward_kinematics public :: solve_inverse_kinematics public :: vecfcn public :: jacobianfcn public :: least_squares_solver public :: iteration_behavior public :: vecfcn_helper public :: jacobian_generating_vector public :: dh_jacobian public :: REVOLUTE_JOINT public :: PRISMATIC_JOINT public :: coordinate_system public :: dh_parameter_set public :: dh_table ! DYNAMICS_VIBRATIONS public :: q_factor public :: estimate_bandwidth public :: logarithmic_decrement public :: damping_from_log_decrement public :: find_free_response_properties public :: rise_time public :: find_settling_amplitude public :: damping_from_fractional_overshoot public :: evaluate_step_response ! DYNAMICS_HELPER public :: cross_product public :: to_skew_symmetric public :: vector_angle public :: scalar_projection public :: vector_projection ! DYNAMICS_STABILITY public :: HYPERBOLIC_FIXED_POINT_SINK public :: HYPERBOLIC_FIXED_POINT_SOURCE public :: HYPERBOLIC_FIXED_POINT_SADDLE public :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE public :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE public :: NONHYPERBOLIC_FIXED_POINT_CENTER public :: determine_local_stability ! DYNAMICS_CONTROLS public :: polynomial public :: state_space public :: transfer_function public :: lti_solve public :: ss_excitation public :: ode_integrator ! DYNAMICS_SYSTEM_ID public :: dynamic_system_measurement public :: model_information public :: siso_model_fit_least_squares public :: constraint_equations ! DYNAMICS_LINKAGE public :: binary_link public :: serial_linkage ! DYNAMICS_GEOMETRY public :: plane public :: plane_normal public :: line public :: plucker_line public :: is_parallel public :: is_point_on_plane public :: is_point_on_line public :: nearest_point_on_line public :: point_to_line_distance public :: point_to_plane_distance public :: vector_plane_projection public :: point_plane_projection public :: matmul public :: line_from_point_and_vector public :: line_common_normal public :: do_lines_intersect ! DYNAMICS_QUATERNIONS public :: quaternion public :: abs public :: conjg public :: real public :: aimag public :: inverse public :: exp public :: log public :: dot_product ! OPERATORS public :: operator ( + ) public :: operator ( - ) public :: operator ( * ) public :: operator ( / ) public :: assignment ( = ) public :: operator ( ** ) end module","tags":"","loc":"sourcefile\\dynamics.f90.html"},{"title":"dynamics_controls.f90 – DYNAMICS","text":"Contents Modules dynamics_controls Source Code dynamics_controls.f90 Source Code module dynamics_controls use iso_fortran_env use nonlin_polynomials use ferror use ieee_arithmetic use dynamics_error_handling use diffeq use linalg , only : eigen use lapack , only : dgetrf , dgetri , dgetrs , zgels implicit none private public :: polynomial public :: state_space public :: transfer_function public :: operator ( * ) public :: lti_solve public :: ss_excitation public :: ode_integrator ! ------------------------------------------------------------------------------ type state_space !! Defines a state-space representation of a dynamic system. This !! implementation takes the form: !! !! \\dot{x}(t) = A x(t) + B u(t) !! y(t) = C x(t) + D u(t) !! !! Where: !! !! - t denotes time. !! !! - x(t) is the state vector. !! !! - u(t) is the input vector. !! !! - y(t) is the output vector. real ( real64 ), allocatable , dimension (:,:) :: A !! The N-by-N dynamics matrix, where N is the number of state !! variables. real ( real64 ), allocatable , dimension (:,:) :: B !! The N-by-M input matrix, where M is the number of inputs. real ( real64 ), allocatable , dimension (:,:) :: C !! The P-by-N output matrix, where P is the number of outputs. real ( real64 ), allocatable , dimension (:,:) :: D !! The P-by-M feedthrough matrix. contains procedure , public :: evaluate_derivatives => ss_eval_deriv procedure , public :: evaluate_output => ss_eval_output procedure , public :: poles => ss_poles procedure , public :: zeros => ss_zeros generic , public :: transfer_function => ss_transfer_fcn , & ss_transfer_fcn_omega , ss_transfer_fcn_array , & ss_transfer_fcn_omega_array procedure , private :: ss_transfer_fcn procedure , private :: ss_transfer_fcn_omega procedure , private :: ss_transfer_fcn_array procedure , private :: ss_transfer_fcn_omega_array end type interface state_space module procedure :: state_space_init module procedure :: state_space_init_scalar module procedure :: state_space_init_matrices module procedure :: state_space_init_pid module procedure :: state_space_init_pid_plant end interface ! ------------------------------------------------------------------------------ type transfer_function !! Defines a transfer function for a continuous system of the form !! H(s) = \\frac{Y(s)}{X(s)} . type ( polynomial ) :: Y !! The numerator polynomial Y(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! y_1 + y_2 s + y_3 s^2 ... . type ( polynomial ) :: X !! The denominator polynomial X(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! x_1 + x_2 s + x_3 s^2 ... . contains procedure , private :: tf_eval_s procedure , private :: tf_eval_omega generic , public :: evaluate => tf_eval_omega , tf_eval_s procedure , public :: poles => tf_poles procedure , public :: zeros => tf_zeros procedure , public :: to_ccf_state_space => tf_to_ccf_statespace procedure , public :: to_ocf_state_space => tf_to_ocf_statespace end type interface transfer_function module procedure :: init_tf_array module procedure :: init_tf_poly end interface ! ------------------------------------------------------------------------------ interface operator ( * ) module procedure :: tf_tf_mult module procedure :: poly_tf_mult module procedure :: tf_poly_mult module procedure :: tf_scalar_mult module procedure :: scalar_tf_mult end interface ! ------------------------------------------------------------------------------ interface subroutine ss_excitation ( t , u , args ) !! A routine for computing the excitation vector for a state-space !! model. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: t !! The time value at which to compute the excitation. real ( real64 ), intent ( out ), dimension (:) :: u !! The excitation vector. class ( * ), intent ( inout ), optional :: args !! An optional argument used to pass objects in and out of the !! routine. end subroutine end interface ! ------------------------------------------------------------------------------ ! PRIVATE TYPES ! ------------------------------------------------------------------------------ type argument_container procedure ( ss_excitation ), pointer , nopass :: excitation class ( * ), allocatable :: user_args logical :: has_user_args class ( state_space ), pointer :: model end type contains ! ****************************************************************************** ! STATE_SPACE ! ------------------------------------------------------------------------------ pure function state_space_init ( m , b , k , n_out ) result ( rst ) !! Initializes the state space model. !! !! The output matrix C is initialized to one, and the !! feedthrough matrix D is initialized to zero. real ( real64 ), intent ( in ), dimension (:,:) :: m !! The N-by-N mass matrix. real ( real64 ), intent ( in ), dimension ( size ( m , 1 ), size ( m , 2 )) :: b !! The N-by-N damping matrix. real ( real64 ), intent ( in ), dimension ( size ( m , 1 ), size ( m , 2 )) :: k !! The N-by-N stiffness matrix. integer ( int32 ), intent ( in ), optional :: n_out !! The number of outputs. The default is 1. type ( state_space ) :: rst !! The [[state_space]] model. ! Local Variables integer ( int32 ) :: ii , jj , n , p , q , lwork , info integer ( int32 ), allocatable , dimension (:) :: pvt real ( real64 ) :: temp ( 1 ) real ( real64 ), allocatable , dimension (:) :: work ! Initialization p = size ( m , 1 ) n = 2 * p q = 1 if ( present ( n_out )) q = n_out if ( q <= 1 ) q = 1 allocate ( & rst % A ( n , n ), & rst % B ( n , p ), & rst % D ( q , p ), & source = 0.0d0 & ) allocate ( rst % C ( q , n ), source = 1.0d0 ) allocate ( pvt ( p )) ! Workspace call dgetri ( p , rst % b ( p + 1 : n ,:), p , pvt , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Build p-by-p Identity sub-matrix matrix jj = p + 1 do ii = 1 , p rst % A ( ii , jj ) = 1.0d0 jj = jj + 1 end do ! Fill in the matrices rst % B ( p + 1 : n , 1 : p ) = m rst % A ( p + 1 : n , 1 : p ) = - k rst % A ( p + 1 : n , p + 1 : n ) = - b call dgetrf ( p , p , rst % B ( p + 1 : n , 1 : p ), p , pvt , info ) call dgetrs ( 'N' , p , p , rst % B ( p + 1 : n , 1 : p ), p , pvt , rst % A ( p + 1 : n , 1 : p ), p , & info ) call dgetrs ( 'N' , p , p , rst % B ( p + 1 : n , 1 : p ), p , pvt , rst % A ( p + 1 : n , p + 1 : n ), & p , info ) call dgetri ( p , rst % B ( p + 1 : n , 1 : p ), p , pvt , work , lwork , info ) end function ! ------------------------------------------------------------------------------ pure function state_space_init_scalar ( m , b , k ) result ( rst ) !! Initializes the state space model. !! !! The output matrix C is initialized to one, and the !! feedthrough matrix D is initialized to zero. real ( real64 ), intent ( in ) :: m !! The mass. real ( real64 ), intent ( in ) :: b !! The damping. real ( real64 ), intent ( in ) :: k !! The stiffness. type ( state_space ) :: rst !! The [[state_space]] model. ! Process allocate ( & rst % A ( 2 , 2 ), & rst % B ( 2 , 1 ), & rst % D ( 1 , 1 ), & source = 0.0d0 & ) allocate ( rst % C ( 1 , 2 ), source = 1.0d0 ) rst % A ( 2 , 1 ) = - k / m rst % A ( 1 , 2 ) = 1.0d0 rst % A ( 2 , 2 ) = - b / m rst % B ( 2 , 1 ) = 1.0d0 / m end function ! ------------------------------------------------------------------------------ pure function state_space_init_matrices ( a , b , c , d ) result ( rst ) !! Initializes the state space model. real ( real64 ), intent ( in ), dimension (:,:) :: a !! The N-by-N dynamics matrix. real ( real64 ), intent ( in ), dimension (:,:) :: b !! The N-by-M input matrix. real ( real64 ), intent ( in ), dimension (:,:) :: c !! The P-by-N output matrix. real ( real64 ), intent ( in ), dimension (:,:) :: d !! The P-by-M feedthrough matrix. type ( state_space ) :: rst !! The resulting [[state_space]] object. allocate ( rst % A , source = a ) allocate ( rst % B , source = b ) allocate ( rst % C , source = c ) allocate ( rst % D , source = d ) end function ! ------------------------------------------------------------------------------ pure function state_space_init_pid ( kp , ki , kd , tau , a , b , c , d ) result ( rst ) !! Initializes a state-space model that employs a closed-loop PID !! controller. !! !! The PID model is augmented into the plant model as follows. !! !! e = r - y !! \\dot{x_1} = e !! \\dot{x_3} = -\\frac{x_3}{\\tau} + \\frac{e}{\\tau} !! u = K_{i} x_{i} + K_{p} e + \\frac{K_{d}}{\\tau} \\left(e - !! x_{3} \\right) !! \\alpha = K_{p} + \\frac{K_{d}}{\\tau} !! \\beta = \\frac{1}{1 + \\alpha D} !! x = \\left[ \\begin{matrix} x_{p} \\\\ x_{1} \\\\ x_{3} \\end{matrix} !! \\right] !! \\dot{x} = A_{cl} x + B_{cl} r !! y = C_{cl} x + D_{cl} r !! !! Where the augmented matrices are as follows. !! !! A_{cl} = \\left[ \\begin{matrix} A - \\alpha \\beta B C & !! \\beta K_{i} B & -\\frac{\\beta K_{d}}{\\tau} B \\\\ !! -C + \\alpha \\beta D C & -\\beta K_{i} D & \\frac{\\beta K_{d}}{\\tau} D !! \\\\ \\frac{1}{\\tau}\\left(-C + \\alpha \\beta D C \\right) & !! -\\frac{\\beta K_{i}}{\\tau} D & \\frac{1}{\\tau} \\left( !! 1 + \\frac{\\beta K_{d}}{\\tau^{2}} D \\right) \\end{matrix} \\right] !! B_{cl} = \\left[ \\begin{matrix} \\alpha \\beta B \\\\ 1 - !! \\alpha \\beta D \\\\ \\frac{1}{\\tau} \\left( 1 - \\alpha \\beta D \\right) !! \\end{matrix} \\right] !! C_{cl} = \\left[ \\begin{matrix} C - \\alpha \\beta D C & !! \\beta K_{i} D & -\\frac{\\beta K_{d}}{\\tau} D \\end{matrix} \\right] !! D_{cl} = \\alpha \\beta D real ( real64 ), intent ( in ) :: kp !! The proportional gain term. real ( real64 ), intent ( in ) :: ki !! The integral gain term. real ( real64 ), intent ( in ) :: kd !! The derivative gain term. real ( real64 ), intent ( in ) :: tau !! The time constant of the first order derivative filter !! K_{d} \\frac{s}{\\tau s + 1} . real ( real64 ), intent ( in ), dimension (:,:) :: a !! The N-by-N dynamics matrix for the plant. real ( real64 ), intent ( in ), dimension ( size ( a , 1 ), 1 ) :: b !! The N-by-1 input matrix for the plant. real ( real64 ), intent ( in ), dimension ( 1 , size ( a , 1 )) :: c !! The 1-by-N output matrix for the plant. real ( real64 ), intent ( in ), dimension ( 1 , 1 ) :: d !! The 1-by-1 feedthrough matrix for the plant. type ( state_space ) :: rst !! The resulting [[state_space]] object. ! Local Variables integer ( int32 ) :: n , n1 , n2 real ( real64 ) :: alpha , beta , ab real ( real64 ), allocatable , dimension (:,:) :: dc ! Initialization n = size ( a , 1 ) n1 = n + 1 n2 = n + 2 allocate ( & rst % A ( n2 , n2 ), & rst % B ( n2 , 1 ), & rst % C ( 1 , n2 ), & rst % D ( 1 , 1 ) & ) dc = matmul ( d , c ) ! Process alpha = kp + kd / tau if ( d ( 1 , 1 ) == 0.0d0 ) then beta = 1.0d0 else beta = 1.0d0 / ( 1.0d0 + alpha * d ( 1 , 1 )) end if ab = alpha * beta rst % A ( 1 : n , 1 : n ) = a - ab * matmul ( b , c ) rst % A ( n1 , 1 : n ) = - c ( 1 , 1 : n ) + ab * dc ( 1 , 1 : n ) rst % A ( 4 , 1 : n ) = ( 1.0d0 / tau ) * rst % A ( 3 , 1 : 2 ) rst % A ( 1 : n , n1 ) = beta * ki * b ( 1 : n , 1 ) rst % A ( n1 , n1 ) = - beta * ki * d ( 1 , 1 ) rst % A ( n2 , n1 ) = rst % A ( 3 , 3 ) / tau rst % A ( 1 : n , n2 ) = - ( beta * kd / tau ) * b ( 1 : n , 1 ) rst % A ( n1 , n2 ) = beta * kd * d ( 1 , 1 ) / tau rst % A ( n2 , n2 ) = - 1.0d0 / tau + beta * kd * d ( 1 , 1 ) / ( tau ** 2 ) rst % B ( 1 : n , 1 ) = ab * b ( 1 : n , 1 ) rst % B ( n1 , 1 ) = 1.0d0 - ab * d ( 1 , 1 ) rst % B ( n2 , 1 ) = ( 1.0d0 / tau ) * rst % B ( 3 , 1 ) rst % C ( 1 , 1 : n ) = c ( 1 , 1 : n ) - ab * dc ( 1 , 1 : n ) rst % C ( 1 , n1 ) = beta * ki * d ( 1 , 1 ) rst % C ( 1 , n2 ) = - ( beta * kd / tau ) * d ( 1 , 1 ) rst % D = ab * d end function ! ------------------------------------------------------------------------------ pure function state_space_init_pid_plant ( kp , ki , kd , tau , plant ) result ( rst ) !! Initializes a state-space model that employs a closed-loop PID !! controller. !! !! The PID model is augmented into the plant model as follows. !! !! e = r - y !! \\dot{x_1} = e !! \\dot{x_3} = -\\frac{x_3}{\\tau} + \\frac{e}{\\tau} !! u = K_{i} x_{i} + K_{p} e + \\frac{K_{d}}{\\tau} \\left(e - !! x_{3} \\right) !! \\alpha = K_{p} + \\frac{K_{d}}{\\tau} !! \\beta = \\frac{1}{1 + \\alpha D} !! x = \\left[ \\begin{matrix} x_{p} \\\\ x_{1} \\\\ x_{3} \\end{matrix} !! \\right] !! \\dot{x} = A_{cl} x + B_{cl} r !! y = C_{cl} x + D_{cl} r !! !! Where the augmented matrices are as follows. !! !! A_{cl} = \\left[ \\begin{matrix} A - \\alpha \\beta B C & !! \\beta K_{i} B & -\\frac{\\beta K_{d}}{\\tau} B \\\\ !! -C + \\alpha \\beta D C & -\\beta K_{i} D & \\frac{\\beta K_{d}}{\\tau} D !! \\\\ \\frac{1}{\\tau}\\left(-C + \\alpha \\beta D C \\right) & !! -\\frac{\\beta K_{i}}{\\tau} D & \\frac{1}{\\tau} \\left( !! 1 + \\frac{\\beta K_{d}}{\\tau^{2}} D \\right) \\end{matrix} \\right] !! B_{cl} = \\left[ \\begin{matrix} \\alpha \\beta B \\\\ 1 - !! \\alpha \\beta D \\\\ \\frac{1}{\\tau} \\left( 1 - \\alpha \\beta D \\right) !! \\end{matrix} \\right] !! C_{cl} = \\left[ \\begin{matrix} C - \\alpha \\beta D C & !! \\beta K_{i} D & -\\frac{\\beta K_{d}}{\\tau} D \\end{matrix} \\right] !! D_{cl} = \\alpha \\beta D real ( real64 ), intent ( in ) :: kp !! The proportional gain term. real ( real64 ), intent ( in ) :: ki !! The integral gain term. real ( real64 ), intent ( in ) :: kd !! The derivative gain term. real ( real64 ), intent ( in ) :: tau !! The time constant of the first order derivative filter !! K_{d} \\frac{s}{\\tau s + 1} . class ( state_space ), intent ( in ) :: plant !! The plant model. type ( state_space ) :: rst !! The resulting [[state_space]] object. rst = state_space_init_pid ( kp , ki , kd , tau , plant % A , plant % B , & plant % C , plant % D ) end function ! ------------------------------------------------------------------------------ pure function ss_eval_deriv ( this , u , x ) result ( rst ) !! Evaluates the state time derivative \\dot{x}(t) = A x(t) + !! B u(t) . class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ), dimension (:) :: u !! The M-element input array. real ( real64 ), intent ( in ), dimension (:) :: x !! The N-element state array. real ( real64 ), allocatable , dimension (:) :: rst !! The N-element state time derivative vector. rst = matmul ( this % A , x ) + matmul ( this % B , u ) end function ! ------------------------------------------------------------------------------ pure function ss_eval_output ( this , u , x ) result ( rst ) !! Evaluates the output vector y(t) = C x(t) + D u(t) . class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ), dimension (:) :: u !! The M-element input array. real ( real64 ), intent ( in ), dimension (:) :: x !! The N-element state array. real ( real64 ), allocatable , dimension (:) :: rst !! The P-element output array. rst = matmul ( this % C , x ) + matmul ( this % D , u ) end function ! ------------------------------------------------------------------------------ function ss_poles ( this , err ) result ( rst ) !! Computes the poles of the state space model. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The poles of the model. ! Local Variables integer ( int32 ) :: n real ( real64 ), allocatable , dimension (:,:) :: ac ! Process n = size ( this % A , 1 ) allocate ( rst ( n )) if ( n == 0 ) return allocate ( ac ( n , n ), source = this % A ) call eigen ( ac , rst , err = err ) end function ! ------------------------------------------------------------------------------ function ss_zeros ( this , err ) result ( rst ) !! Computes the zeros of the state space model. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The zeros of the model. ! Local Variables integer ( int32 ) :: i , j , n , m , p , nz real ( real64 ), allocatable , dimension (:,:) :: Az , Bz complex ( real64 ), allocatable , dimension (:) :: buffer , trimmed ! Initialization n = size ( this % A , 1 ) m = size ( this % B , 2 ) p = size ( this % C , 1 ) nz = n + max ( m , p ) allocate ( Az ( nz , nz ), Bz ( nz , nz ), source = 0.0d0 ) allocate ( buffer ( nz ), trimmed ( nz )) ! Build the matrices Az ( 1 : n , 1 : n ) = this % A Az ( 1 : n , n + 1 : n + m ) = this % B do i = 1 , nz Bz ( i , i ) = 1.0d0 end do Bz ( n + 1 : n + p , 1 : n ) = this % C Bz ( n + 1 : n + p , n + 1 : n + m ) = this % D ! Compute the eigenvalues call eigen ( Az , Bz , buffer ) ! Only keep the physically realizable zeros - exclude NaN's and (0,0) j = 0 do i = 1 , nz if ( ieee_is_nan ( real ( buffer ( i )))) cycle if ( ieee_is_nan ( aimag ( buffer ( i )))) cycle if (. not . ieee_is_finite ( real ( buffer ( i )))) cycle if (. not . ieee_is_finite ( aimag ( buffer ( i )))) cycle if ( abs ( buffer ( i )) <= epsilon ( 0.0d0 )) cycle j = j + 1 trimmed ( j ) = buffer ( i ) end do rst = trimmed ( 1 : j ) end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn ( this , s ) result ( rst ) !! Evaluates the transfer functions for the model at the parameter s. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. complex ( real64 ), intent ( in ) :: s !! The frequency at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting transfer functions. ! Local Variables integer ( int32 ) :: j , ninput , noutput , n , info , lwork complex ( real64 ) :: temp ( 1 ) complex ( real64 ), allocatable , dimension (:) :: work , Bj complex ( real64 ), allocatable , dimension (:,:) :: A , Ac ! Initialization n = size ( this % A , 1 ) ninput = size ( this % B , 2 ) noutput = size ( this % C , 1 ) allocate ( rst ( noutput , ninput )) allocate ( Ac ( n , n ), Bj ( n )) ! Determine DGELS workspace requirements call zgels ( 'N' , n , n , 1 , Ac , n , Bj , n , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Build s * I - A do j = 1 , n Ac (:, j ) = - this % A (:, j ) Ac ( j , j ) = Ac ( j , j ) + s end do allocate ( A ( n , n ), source = Ac ) ! For each column j, solve Ac * x(j) = B(j) and then compute ! the output: C x(j) + D(j) do j = 1 , ninput if ( j /= 1 ) A = Ac ! We need a copy as A will be overwritten Bj = this % B (:, j ) call zgels ( 'N' , n , n , 1 , A , n , Bj , n , work , lwork , info ) rst (:, j ) = matmul ( this % C , Bj ) + this % D (:, j ) end do end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn_omega ( this , omega ) result ( rst ) !! Evaluates the transfer functions for the model at frequency \\omega. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ) :: omega !! The frequency at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting transfer functions. ! Local Variables complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) complex ( real64 ) :: s ! Process s = j * omega rst = ss_transfer_fcn ( this , s ) end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn_array ( this , s ) result ( rst ) !! Evaluates the transfer functions for the model at the frequencies given !! in the array s. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. complex ( real64 ), intent ( in ), dimension (:) :: s !! The frequencies at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:,:) :: rst !! The resulting transfer functions, with each page of the array !! containing the transfer functions for a specific frequency. ! Local Variables integer ( int32 ) :: i , ninput , noutput , n ! Initialization ninput = size ( this % B , 2 ) noutput = size ( this % C , 1 ) n = size ( s ) allocate ( rst ( noutput , ninput , n )) ! Process do concurrent ( i = 1 : n ) rst (:,:, i ) = ss_transfer_fcn ( this , s ( i )) end do end function ! ------------------------------------------------------------------------------ pure function ss_transfer_fcn_omega_array ( this , omega ) result ( rst ) !! Evaluates the transfer functions for the model at the frequencies given !! in the array omega. class ( state_space ), intent ( in ) :: this !! The [[state_space]] object. real ( real64 ), intent ( in ), dimension (:) :: omega !! The frequencies at which to evaluate the transfer functions. complex ( real64 ), allocatable , dimension (:,:,:) :: rst !! The resulting transfer functions, with each page of the array !! containing the transfer functions for a specific frequency. ! Local Variables integer ( int32 ) :: i , ninput , noutput , n ! Initialization ninput = size ( this % B , 2 ) noutput = size ( this % C , 1 ) n = size ( omega ) allocate ( rst ( noutput , ninput , n )) ! Process do concurrent ( i = 1 : n ) rst (:,:, i ) = ss_transfer_fcn_omega ( this , omega ( i )) end do end function ! ****************************************************************************** ! TRANSFER_FUNCTION ! ------------------------------------------------------------------------------ function init_tf_poly ( y , x ) result ( rst ) !! Initializes a new transfer function. class ( polynomial ), intent ( in ) :: y !! The numerator polynomial Y(s) in !! H(s) = \\frac{Y(s)}{X(s)} . class ( polynomial ), intent ( in ) :: x !! The denominator polynomial X(s) in !! H(s) = \\frac{Y(s)}{X(s)} . type ( transfer_function ) :: rst !! The resulting [[transfer_function]]. ! Process call rst % Y % initialize ( y % get_all ()) call rst % X % initialize ( x % get_all ()) end function ! ------------------------------------------------------------------------------ function init_tf_array ( y , x ) result ( rst ) !! Initializes a new transfer function. real ( real64 ), intent ( in ), dimension (:) :: y !! The numerator polynomial Y(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! y_1 + y_2 s + y_3 s^2 ... . real ( real64 ), intent ( in ), dimension (:) :: x !! The denominator polynomial X(s) in !! H(s) = \\frac{Y(s)}{X(s)} . The polynomial coefficients !! are stored in acending order such that !! x_1 + x_2 s + x_3 s^2 ... . type ( transfer_function ) :: rst !! The resulting [[transfer_function]]. ! Process call rst % Y % initialize ( y ) call rst % X % initialize ( x ) end function ! ------------------------------------------------------------------------------ pure elemental function tf_eval_s ( this , s ) result ( rst ) !! Evaluates the transfer function at the specified value of the !! Laplace variable s. class ( transfer_function ), intent ( in ) :: this !! The transfer_function object. complex ( real64 ), intent ( in ) :: s !! The Laplace variable at which to evaluate the transfer function. complex ( real64 ) :: rst !! The value of the transfer function. ! Process rst = this % Y % evaluate ( s ) / this % X % evaluate ( s ) end function ! ------------------------------------------------------------------------------ pure elemental function tf_eval_omega ( this , omega ) result ( rst ) !! Evaluates the transfer function at the specified value of the !! \\omega. class ( transfer_function ), intent ( in ) :: this !! The transfer_function object. real ( real64 ), intent ( in ) :: omega !! The frequency, in rad/s, at which to evaluate the transfer !! function. complex ( real64 ) :: rst !! The value of the transfer function. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) ! Local Variables complex ( real64 ) :: s ! Process s = j * omega rst = this % tf_eval_s ( s ) end function ! ------------------------------------------------------------------------------ function tf_poles ( this , err ) result ( rst ) !! Computes the poles of the transfer function. class ( transfer_function ), intent ( in ) :: this !! The transfer_function object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The poles of the transfer function. ! Process rst = this % X % roots ( err = err ) end function ! ------------------------------------------------------------------------------ function tf_zeros ( this , err ) result ( rst ) !! Computes the zeros of the transfer function. class ( transfer_function ), intent ( in ) :: this !! The transfer function object. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. complex ( real64 ), allocatable , dimension (:) :: rst !! The zeros of the transfer function. ! Process rst = this % Y % roots ( err = err ) end function ! ------------------------------------------------------------------------------ function tf_to_ccf_statespace ( this ) result ( rst ) !! Converts a transfer_function type into a controllable canonical form !! state_space type. See !! [this](https://en.wikipedia.org/wiki/State-space_representation) article !! for a description of this form. class ( transfer_function ), intent ( in ) :: this !! The transfer_function to convert. type ( state_space ) :: rst !! The resulting state-space object. ! Local Variables integer ( int32 ) :: i , order , n , norder real ( real64 ) :: a ! Process order = this % X % order () n = order + 1 allocate ( rst % A ( order , order ), rst % B ( order , 1 ), rst % C ( 1 , order ), & rst % D ( 1 , 1 ), source = 0.0d0 ) a = this % X % get ( n ) do i = 1 , order rst % A ( order , i ) = - this % X % get ( i ) / a end do do i = 1 , order - 1 rst % A ( i , i + 1 ) = 1.0d0 end do rst % B ( order , 1 ) = 1.0d0 norder = this % Y % order () do i = 1 , min ( norder + 1 , order ) rst % C ( 1 , i ) = this % Y % get ( i ) / a end do end function ! ------------------------------------------------------------------------------ function tf_to_ocf_statespace ( this ) result ( rst ) !! Converts a transfer_function type into an observable canonical form !! state_space type. See !! [this](https://en.wikipedia.org/wiki/State-space_representation) article !! for a description of this form. class ( transfer_function ), intent ( in ) :: this !! The transfer_function to convert. type ( state_space ) :: rst !! The resulting state-space object. ! Local Variables integer ( int32 ) :: i , order , n , norder real ( real64 ) :: a ! Process order = this % X % order () n = order + 1 allocate ( rst % A ( order , order ), rst % B ( order , 1 ), rst % C ( 1 , order ), & rst % D ( 1 , 1 ), source = 0.0d0 ) a = this % X % get ( n ) do i = 1 , order rst % A ( i , order ) = - this % X % get ( i ) / a end do do i = 1 , order - 1 rst % A ( i + 1 , i ) = 1.0d0 end do norder = this % Y % order () do i = 1 , min ( norder + 1 , order ) rst % B ( i , 1 ) = this % Y % get ( i ) / a end do rst % C ( 1 , order ) = 1.0d0 end function ! ****************************************************************************** ! OPERATORS ! ------------------------------------------------------------------------------ function tf_tf_mult ( x , y ) result ( rst ) !! Multiplies two transfer functions. class ( transfer_function ), intent ( in ) :: x !! The left-hand-side argument. class ( transfer_function ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x % Y * y % Y rst % X = x % X * y % X end function ! ------------------------------------------------------------------------------ function poly_tf_mult ( x , y ) result ( rst ) !! Multiplies a polynomial and a transfer function to result in a new !! transfer function. class ( polynomial ), intent ( in ) :: x !! The left-hand-side argument. class ( transfer_function ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x * y % Y rst % X = y % X end function ! ------------------------------------------------------------------------------ function tf_poly_mult ( x , y ) result ( rst ) !! Multiplies a transfer function and a polynomial to result in a new !! transfer function. class ( transfer_function ), intent ( in ) :: x !! The left-hand-side argument. class ( polynomial ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x % Y * y rst % X = x % X end function ! ------------------------------------------------------------------------------ function tf_scalar_mult ( x , y ) result ( rst ) !! Multiplies a transfer function by a scalar value. class ( transfer_function ), intent ( in ) :: x !! The left-hand-side argument. real ( real64 ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = y * x % Y rst % X = x % X end function ! ------------------------------------------------------------------------------ function scalar_tf_mult ( x , y ) result ( rst ) !! Multiplies a transfer function by a scalar value. real ( real64 ), intent ( in ) :: x !! The left-hand-side argument. class ( transfer_function ), intent ( in ) :: y !! The right-hand-side argument. type ( transfer_function ) :: rst !! The resulting transfer function. ! Process rst % Y = x * y % Y rst % X = y % X end function ! ****************************************************************************** ! LTI SOLVERS ! ------------------------------------------------------------------------------ function lti_solve ( mdl , u , t , ic , solver , args , err ) result ( rst ) !! Solves the LTI system given by the specified state space model. class ( state_space ), intent ( in ), target :: mdl !! The state_space model to solve. procedure ( ss_excitation ), pointer , intent ( in ) :: u !! The routine used to compute the excitation vector. real ( real64 ), intent ( in ), dimension (:) :: t !! The time points at which to compute the solution. The array must !! have at least 2 values; however, more may be specified. If only !! 2 values are specified, the integrator will compute the solution at !! those points, but it will also return any intermediate integration !! steps that may be required. However, if more than 2 points are !! given, the integrator will return the solution values only at the !! specified time points. real ( real64 ), intent ( in ), dimension (:) :: ic !! The initial condition vector. This array must be the same size as !! the number of state variables. class ( ode_integrator ), intent ( in ), optional , target :: solver !! The ODE solver to utilize. If not specified, the default solver !! is a 4th/5th order Runge-Kutta integrator. class ( * ), intent ( inout ), optional :: args !! An optional container for arguments to pass to the excitation !! routine. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The solution. The time points at which the solution was evaluated !! are stored in the first column and the output(s) are stored in the !! remaining column(s). ! Local Variables integer ( int32 ) :: i , n , npts , flag , nInputs , nOutputs real ( real64 ), allocatable , dimension (:) :: uv real ( real64 ), allocatable , dimension (:,:) :: sol type ( argument_container ) :: container class ( errors ), pointer :: errmgr type ( errors ), target :: deferr class ( ode_integrator ), pointer :: integrator type ( runge_kutta_45 ), target :: defaultIntegrator type ( ode_container ) :: odeMdl ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if container % excitation => u container % model => mdl container % has_user_args = present ( args ) if ( present ( args )) allocate ( container % user_args , source = args ) n = size ( mdl % A , 1 ) nInputs = size ( mdl % B , 2 ) nOutputs = size ( mdl % C , 1 ) ! Input Checking if ( size ( ic ) /= n ) then call report_array_size_error ( \"lti_solve_statespace\" , \"ic\" , n , & size ( ic ), errmgr ) return end if ! Set up the integrator if ( present ( solver )) then integrator => solver else integrator => defaultIntegrator end if odeMdl % fcn => ode_solver_routine ! Call the solver call integrator % solve ( odeMdl , t , ic , args = container , err = errmgr ) if ( errmgr % has_error_occurred ()) return ! Get the output from the solver sol = integrator % get_solution () npts = size ( sol , 1 ) allocate ( rst ( npts , nOutputs + 1 ), uv ( nInputs ), stat = flag , source = 0.0d0 ) if ( flag /= 0 ) then call report_memory_error ( \"lti_solve_statespace\" , flag , errmgr ) return end if ! Compute: C * x + D * u do i = 1 , npts call u ( sol ( i , 1 ), uv , args ) rst ( i , 1 ) = sol ( i , 1 ) rst ( i , 2 :) = mdl % evaluate_output ( uv , sol ( i , 2 :)) end do end function ! ---------- subroutine ode_solver_routine ( t , x , dxdt , args ) ! The routine called by the LTI solver real ( real64 ), intent ( in ) :: t , x (:) real ( real64 ), intent ( out ) :: dxdt (:) class ( * ), intent ( inout ), optional :: args ! Local Variables integer ( int32 ) :: n , p real ( real64 ) :: nan real ( real64 ), allocatable , dimension (:) :: u ! Initialization nan = ieee_value ( nan , IEEE_QUIET_NAN ) ! Process select type ( args ) class is ( argument_container ) ! Evaluate the excitation vector at t n = size ( args % model % B , 2 ) allocate ( u ( n ), source = 0.0d0 ) if ( args % has_user_args ) then call args % excitation ( t , u , args = args % user_args ) else call args % excitation ( t , u ) end if ! Evaluate the model dxdt = args % model % evaluate_derivatives ( u , x ) class default dxdt = nan end select end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_controls.f90.html"},{"title":"dynamics_error_handling.f90 – DYNAMICS","text":"Contents Modules dynamics_error_handling Source Code dynamics_error_handling.f90 Source Code module dynamics_error_handling use ferror use iso_fortran_env use diffeq_errors , only : DIFFEQ_INVALID_INPUT_ERROR , & DIFFEQ_MEMORY_ALLOCATION_ERROR , DIFFEQ_NULL_POINTER_ERROR use fstats_errors , only : FS_UNDERDEFINED_PROBLEM_ERROR , & FS_TOLERANCE_TOO_SMALL_ERROR , FS_TOO_FEW_ITERATION_ERROR use nonlin_error_handling , only : NL_CONVERGENCE_ERROR implicit none integer ( int32 ), parameter :: DYN_MEMORY_ERROR = DIFFEQ_MEMORY_ALLOCATION_ERROR !! Defines an error associated with memory allocations. integer ( int32 ), parameter :: DYN_NULL_POINTER_ERROR = DIFFEQ_NULL_POINTER_ERROR !! Defines an error associated with a null pointer. integer ( int32 ), parameter :: DYN_INVALID_INPUT_ERROR = DIFFEQ_INVALID_INPUT_ERROR !! Defines an error associated with an invalid input. integer ( int32 ), parameter :: DYN_MATRIX_SIZE_ERROR = 100100 !! Defines an error associated with an incorrectly sized matrix. integer ( int32 ), parameter :: DYN_ZERO_VALUED_FREQUENCY_ERROR = 100101 !! Defines an error associated with a zero-valued frequency. integer ( int32 ), parameter :: DYN_CONSTRAINT_ERROR = 100102 !! Defines a constraint-related error. integer ( int32 ), parameter :: DYN_INDEX_OUT_OF_RANGE = 100103 !! Defines an index out of range error. integer ( int32 ), parameter :: DYN_NONMONOTONIC_ARRAY_ERROR = 100104 !! Defines an error related to an array being nonmonotonic. integer ( int32 ), parameter :: DYN_ARRAY_SIZE_ERROR = 100105 !! Defines an error for an improperly sized array. integer ( int32 ), parameter :: DYN_UNDERDEFINED_PROBLEM_EROR = FS_UNDERDEFINED_PROBLEM_ERROR !! Defines an error for an underdefined problem. integer ( int32 ), parameter :: DYN_TOLERANCE_TOO_SMALL_ERROR = FS_TOLERANCE_TOO_SMALL_ERROR !! Defines an error related to the request of a too small tolerance !! value. integer ( int32 ), parameter :: DYN_TOO_FEW_ITERATIONS_ERROR = FS_TOO_FEW_ITERATION_ERROR !! Defines an error when too few iterations were allowed. integer ( int32 ), parameter :: DYN_CONVERGENCE_ERROR = NL_CONVERGENCE_ERROR !! Defines an error related to convergence issues. contains ! ------------------------------------------------------------------------------ subroutine report_null_forcing_routine_error ( name , err ) !! Reports a null forcing routine pointer error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Report the error call err % report_error ( name , & \"No forcing function routine was supplied.\" , & DYN_NULL_POINTER_ERROR ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_null_solver_routine_error ( name , err ) !! Reports a null solver routine error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Report the error call err % report_error ( name , & \"No routine has been defined to supply to the solver.\" , & DYN_NULL_POINTER_ERROR ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_memory_error ( name , flag , err ) !! Reports a memory allocation error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: flag !! The flag returned from the allocate statement. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Memory allocation error flag \" , flag , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MEMORY_ERROR ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonsquare_mass_matrix_error ( name , m , n , err ) !! Reports an error relating to a non-square mass matrix. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: m !! The number of rows found in the mass matrix. integer ( int32 ), intent ( in ) :: n !! The number of columns found in the mass matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The mass matrix is not square. \" // & \"It was found to be \" , m , \"-by-\" , n , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonsquare_stiffness_matrix_error ( name , m , n , err ) !! Reports an error relating to a non-square stiffness matrix. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: m !! The number of rows found in the stiffness matrix. integer ( int32 ), intent ( in ) :: n !! The number of columns found in the stiffness matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The stiffness matrix is not square. \" // & \"It was found to be \" , m , \"-by-\" , n , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonsquare_matrix_error ( name , var , m , n , err ) !! Reports an error relating to a non-square matrix. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: m !! The number of rows found in the matrix. integer ( int32 ), intent ( in ) :: n !! The number of columns found in the matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Matrix \" // var // \" is not square. \" // & \"It was found to be \" , m , \"-by-\" , n , \".\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_matrix_size_mismatch_error ( name , mtx1 , mtx2 , m1 , n1 , & m2 , n2 , err ) !! Reports a mismatch in matrix sizes. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: mtx1 !! The name of the first matrix. character ( len = * ), intent ( in ) :: mtx2 !! The name of the second matrix. integer ( int32 ), intent ( in ) :: m1 !! The number of rows in the first matrix. integer ( int32 ), intent ( in ) :: n1 !! The number of columns in the first matrix. integer ( int32 ), intent ( in ) :: m2 !! The number of rows in the second matrix. integer ( int32 ), intent ( in ) :: n2 !! The number of columns in the second matrix. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The size of the \" // mtx1 // \" matrix (\" , m1 , & \"-by-\" , n1 , \") does not match the size of the \" // mtx2 , & \" matrix (\" , m2 , \"-by-\" , n2 , \").\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_zero_valued_frequency_error ( name , index , err ) !! Reports an error associated with a zero-valued frequency value. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: index !! The array index at which the zero-valued frequency was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"A zero-valued frequency was found at index \" , & index , \".\" call err % report_error ( name , trim ( errmsg ), & DYN_ZERO_VALUED_FREQUENCY_ERROR ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_generic_counting_error ( name , str1 , val , str2 , flag , err ) !! A generic error reporting routine. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: str1 !! The first string. integer ( int32 ), intent ( in ) :: val !! The integer value. character ( len = * ), intent ( in ) :: str2 !! The second string. integer ( int32 ), intent ( in ) :: flag !! The error flag. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 512 ) :: errmsg ! Report the error write ( errmsg , 100 ) str1 , val , str2 call err % report_error ( name , trim ( errmsg ), flag ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_zero_difference_error ( name , var1 , val1 , var2 , val2 , & flag , err ) !! Reports a zero-difference between two variables where a non-zero !! difference was expected. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var1 !! The name of the first variable. real ( real64 ), intent ( in ) :: val1 !! The value of the first variable. character ( len = * ), intent ( in ) :: var2 !! The name of the second variable. real ( real64 ), intent ( in ) :: val2 !! The value of the second variable. integer ( int32 ), intent ( in ) :: flag !! The error flag. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"A non-zero difference between \" // var1 // & \" (\" , val1 , \"), and \" // var2 // \" (\" , val2 , \") was expected.\" call err % report_error ( name , trim ( errmsg ), flag ) ! Formatting 100 format ( A , F0 . 4 , A , F0 . 4 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_overconstraint_error ( name , err ) !! Reports an overconstraint error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Report the error call err % report_error ( name , \"The model is overconstrained.\" , & DYN_CONSTRAINT_ERROR ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_array_index_out_of_bounds_error ( name , var , ind , sz , err ) !! Reports an array index-out-of-bounds error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: ind !! The offending index. integer ( int32 ), intent ( in ) :: sz !! The array size. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) & \"Index \" , ind , \" is outside the bounds of array \" // var // & \", which is of size \" , sz , \".\" call err % report_error ( name , trim ( errmsg ), DYN_INDEX_OUT_OF_RANGE ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_nonmonotonic_array_error ( name , var , ind , err ) !! Reports a nonmonotonic array error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: ind !! The index of the occurrence of nonmonotonicity. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Array \" // var // & \" was found to be nonmonotonic at index \" , ind , \".\" call err % report_error ( name , trim ( errmsg ), DYN_NONMONOTONIC_ARRAY_ERROR ) ! Formatting 100 format ( A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_constraint_count_error ( name , expected , actual , err ) !! Reports an error associated with an incorrect number of constraints. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: expected !! The expected number of constraints. integer ( int32 ), intent ( in ) :: actual !! The actual number of constraints. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Expected to find \" , expected , & \" constraints, but found \" , actual , \" constraints instead.\" call err % report_error ( name , trim ( errmsg ), DYN_CONSTRAINT_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_array_size_error ( name , var , expected , actual , err ) !! Reports an array size error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: expected !! The expected array size. integer ( int32 ), intent ( in ) :: actual !! The actual array size. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 256 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Expected array \" // var // \" to be of size \" , & expected , \", but found it to be of size \" , actual , \".\" call err % report_error ( name , trim ( errmsg ), DYN_ARRAY_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_matrix_size_error ( name , var , expect_rows , expect_cols , & actual_rows , actual_cols , err ) !! Reports a matrix size error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. character ( len = * ), intent ( in ) :: var !! The name of the offending variable. integer ( int32 ), intent ( in ) :: expect_rows !! The expected number of rows. integer ( int32 ), intent ( in ) :: expect_cols !! The expected number of columns. integer ( int32 ), intent ( in ) :: actual_rows !! The actual number of rows. integer ( int32 ), intent ( in ) :: actual_cols !! The actual number of columns. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 512 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"Expected matrix \" // var // \" to be of size (\" , & expect_rows , \"-by-\" , expect_cols , & \"), but found it to be of size (\" , actual_rows , \"-by-\" , & actual_cols , \").\" call err % report_error ( name , trim ( errmsg ), DYN_MATRIX_SIZE_ERROR ) ! Formatting 100 format ( A , I0 , A , I0 , A , I0 , A , I0 , A ) end subroutine ! ------------------------------------------------------------------------------ subroutine report_convergence_error ( name , niter , resid , err ) !! Reports a convergence error. character ( len = * ), intent ( in ) :: name !! The name of the routine in which the error was found. integer ( int32 ), intent ( in ) :: niter !! The actual number of iterations taken. real ( real64 ), intent ( in ) :: resid !! The current residual estimate. class ( errors ), intent ( inout ) :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. ! Local Variables character ( len = 512 ) :: errmsg ! Report the error write ( errmsg , 100 ) \"The iteration process failed to converge taking \" , & niter , \" iterations with the current residual of \" , resid , \".\" call err % report_error ( name , trim ( errmsg ), DYN_CONVERGENCE_ERROR ) ! Formatting 100 format ( A , I0 , A , E12 . 5 , A ) end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_error_handling.f90.html"},{"title":"dynamics_frequency_response.f90 – DYNAMICS","text":"Contents Modules dynamics_frequency_response Source Code dynamics_frequency_response.f90 Source Code module dynamics_frequency_response use iso_fortran_env use ferror use diffeq , only : ode_container , ode_integrator use dynamics_error_handling use spectrum use fstats implicit none private public :: ode_excite public :: modal_excite public :: harmonic_ode public :: frf public :: mimo_frf public :: chirp public :: frequency_response public :: frequency_sweep public :: compute_modal_damping public :: modal_response public :: normalize_mode_shapes public :: evaluate_accelerance_frf_model public :: evaluate_receptance_frf_model public :: fit_frf public :: FRF_ACCELERANCE_MODEL public :: FRF_RECEPTANCE_MODEL public :: regression_statistics public :: iteration_controls public :: lm_solver_options public :: convergence_info public :: ode_integrator interface function ode_excite ( t ) result ( rst ) !! Defines the interface for a ODE excitation function. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: t !! The value of the independent variable at which to evaluate !! the excitation function. real ( real64 ) :: rst !! The result. end function subroutine modal_excite ( freq , frc , args ) !! Defines the interface to a routine for defining the forcing !! function for a modal frequency analysis. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: freq !! The excitation frequency. When used as a part of a frequency !! response calculation, this value will have the same units as !! the frequency values provided to the frequency response !! routine. complex ( real64 ), intent ( out ), dimension (:) :: frc !! An N-element array where the forcing function should be !! written. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to communicate with !! the outside world. end subroutine subroutine harmonic_ode ( freq , t , x , dxdt , args ) !! Defines a system of ODE's exposed to harmonic excitation. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ) :: freq !! The excitation frequency. real ( real64 ), intent ( in ) :: t !! The current time step value. real ( real64 ), intent ( in ), dimension (:) :: x !! The value of the solution estimate at time t. real ( real64 ), intent ( out ), dimension (:) :: dxdt !! The derivatives as computed by this routine. class ( * ), intent ( inout ), optional :: args !! An optional argument allowing the passing of data in/out of !! this routine. end subroutine end interface type frf !! A container for a frequency response function, or series of frequency !! response functions. real ( real64 ), allocatable , dimension (:) :: frequency !! An N-element array containing the frequency values at which the !! FRF is provided. The units of this array are the same as the !! units of the frequency values passed to the routine used to !! compute the frequency response. complex ( real64 ), allocatable , dimension (:,:) :: responses !! An N-by-M matrix containing the M frequency response functions !! evaluated at each of the N frequency points. end type type mimo_frf !! A container for the frequency responses of a system of multiple !! inputs and multiple outputs (MIMO). real ( real64 ), allocatable , dimension (:) :: frequency !! An N-element array containing the frequency values at which the !! FRF is provided. The units of this array are the same as the !! units of the frequency values passed to the routine used to !! compute the frequency response. complex ( real64 ), allocatable , dimension (:,:,:) :: responses !! An N-by-M-by-P array containing the frequency response functions !! for each of the M outputs corresponding to each of the P inputs. end type interface frequency_response !! Computes the frequency response functions for a system of ODE's. module procedure :: frf_modal_prop_damp module procedure :: frf_modal_prop_damp_2 module procedure :: siso_freqres module procedure :: mimo_freqres end interface interface frequency_sweep module procedure :: frf_sweep_1 module procedure :: frf_sweep_2 end interface interface evaluate_accelerance_frf_model module procedure :: evaluate_accelerance_frf_model_scalar module procedure :: evaluate_accelerance_frf_model_array end interface interface evaluate_receptance_frf_model module procedure :: evaluate_receptance_frf_model_scalar module procedure :: evaluate_receptance_frf_model_array end interface ! ------------------------------------------------------------------------------ integer ( int32 ), parameter :: FRF_ACCELERANCE_MODEL = 1 !! Defines an accelerance frequency response model. integer ( int32 ), parameter :: FRF_RECEPTANCE_MODEL = 2 !! Defines a receptance frequency response model. ! ------------------------------------------------------------------------------ type frf_arg_container procedure ( harmonic_ode ), pointer , nopass :: fcn real ( real64 ) :: frequency logical :: uses_optional_args class ( * ), allocatable :: optional_args end type contains ! ------------------------------------------------------------------------------ pure elemental function chirp ( t , amp , span , f1Hz , f2Hz ) result ( rst ) !! Evaluates a linear chirp function. real ( real64 ), intent ( in ) :: t !! The value of the independent variable at which to evaluate the !! chirp. real ( real64 ), intent ( in ) :: amp !! The amplitude. real ( real64 ), intent ( in ) :: span !! The duration of the time it takes to sweep from the start !! frequency to the end frequency. real ( real64 ), intent ( in ) :: f1Hz !! The lower excitation frequency, in Hz. real ( real64 ), intent ( in ) :: f2Hz !! The upper excitation frequency, in Hz. real ( real64 ) :: rst !! The value of the function at t. real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) real ( real64 ) :: c c = ( f2Hz - f1Hz ) / span rst = amp * sin ( 2.0d0 * pi * t * ( 0.5d0 * c * t + f1Hz )) end function ! ------------------------------------------------------------------------------ function frf_modal_prop_damp ( mass , stiff , alpha , beta , freq , frc , & modes , modeshapes , args , err ) result ( rst ) !! Computes the frequency response functions for a !! multi-degree-of-freedom system that uses proportional damping such !! that the damping matrix C is related to the stiffness an mass !! matrices by proportional damping coefficients \\alpha and !! \\beta by C = \\alpha M + \\beta K . use linalg , only : eigen , sort , mtx_mult , LA_NO_OPERATION , LA_TRANSPOSE use dynamics_error_handling real ( real64 ), intent ( in ), dimension (:,:) :: mass !! The N-by-N mass matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ), dimension (:,:) :: stiff !! The N-by-N stiffness matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ) :: alpha !! The mass damping factor, \\alpha . real ( real64 ), intent ( in ) :: beta !! The stiffness damping factor, \\beta . real ( real64 ), intent ( in ), dimension (:) :: freq !! An M-element array of frequency values at which to evaluate the !! frequency response functions, in units of rad/s. procedure ( modal_excite ), pointer , intent ( in ) :: frc !! A pointer to a routine used to compute the modal forcing !! function. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:) :: modes !! An optional N-element allocatable array that, if supplied, will !! be used to retrieve the modal frequencies, in units of rad/s. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:,:) :: modeshapes !! An optional N-by-N allocatable matrix that, if supplied, will be !! used to retrieve the N mode shapes with each vector occupying !! its own column. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to communicate with !! the outside world. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices !! are not square, or if the mass and stiffness matrices are !! different sized. !! - DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer !! is undefined. type ( frf ) :: rst !! The resulting frequency responses. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) complex ( real64 ), parameter :: zero = ( 0.0d0 , 0.0d0 ) complex ( real64 ), parameter :: one = ( 1.0d0 , 0.0d0 ) ! Local Variables integer ( int32 ) :: i , m , n , flag complex ( real64 ) :: s real ( real64 ), allocatable , dimension (:) :: lambda , zeta real ( real64 ), allocatable , dimension (:,:) :: mmtx , kmtx complex ( real64 ), allocatable , dimension (:) :: vals , q , f , u complex ( real64 ), allocatable , dimension (:,:) :: vecs class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if m = size ( freq ) n = size ( mass , 1 ) ! Input Checking if ( size ( mass , 2 ) /= n ) go to 20 if ( size ( stiff , 1 ) /= size ( stiff , 2 )) go to 30 if ( size ( stiff , 1 ) /= n . or . size ( stiff , 2 ) /= n ) go to 40 if (. not . associated ( frc )) go to 50 ! TO DO: Check for symmetry ! Memory allocations allocate ( mmtx ( n , n ), source = mass , stat = flag ) if ( flag == 0 ) allocate ( kmtx ( n , n ), source = stiff , stat = flag ) if ( flag == 0 ) allocate ( zeta ( n ), stat = flag ) if ( flag == 0 ) allocate ( q ( n ), stat = flag ) if ( flag == 0 ) allocate ( vals ( n ), stat = flag ) if ( flag == 0 ) allocate ( f ( n ), stat = flag , source = zero ) if ( flag == 0 ) allocate ( u ( n ), stat = flag ) if ( flag == 0 ) allocate ( vecs ( n , n ), stat = flag ) if ( flag == 0 ) allocate ( rst % responses ( m , n ), stat = flag ) if ( flag == 0 ) allocate ( rst % frequency ( m ), source = freq , stat = flag ) if ( flag /= 0 ) go to 10 ! Compute the eigenvalues and eigenvectors call eigen ( kmtx , mmtx , vals , vecs = vecs , err = errmgr ) if ( errmgr % has_error_occurred ()) return allocate ( lambda ( n ), source = real ( vals ), stat = flag ) if ( flag /= 0 ) go to 10 ! Compute the damping terms zeta = compute_modal_damping ( lambda , alpha , beta ) ! Compute each transfer function do i = 1 , m call frc ( freq ( i ), f , args ) call mtx_mult ( LA_TRANSPOSE , one , vecs , f , zero , u ) s = j * freq ( i ) q = u / ( s ** 2 + 2.0d0 * zeta * sqrt ( lambda ) * s + lambda ) call mtx_mult ( LA_NO_OPERATION , one , vecs , q , zero , rst % responses ( i ,:)) end do ! If needed, return the modal frequencies and mode shapes if ( present ( modes ) . or . present ( modeshapes )) then ! Sort the modal information call sort ( vals , vecs ) end if if ( present ( modes )) then allocate ( modes ( n ), source = sqrt ( real ( vals )), & stat = flag ) if ( flag /= 0 ) go to 10 end if if ( present ( modeshapes )) then allocate ( modeshapes ( n , n ), source = real ( vecs ), stat = flag ) if ( flag /= 0 ) go to 10 end if ! End return ! Memory error 10 continue call report_memory_error ( \"frf_modal_prop_damp\" , flag , errmgr ) return ! Error: Mass matrix is not square 20 continue call report_nonsquare_mass_matrix_error ( \"frf_modal_prop_damp\" , & size ( mass , 1 ), size ( mass , 2 ), errmgr ) return ! Error: Stiffness matrix is not square 30 continue call report_nonsquare_stiffness_matrix_error ( \"frf_modal_prop_damp\" , & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Error: Stiffness matrix is not sized correctly 40 continue call report_matrix_size_mismatch_error ( \"frf_modal_prop_damp\" , & \"mass\" , \"stiffness\" , size ( mass , 1 ), size ( mass , 2 ), & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Null forcing term pointer 50 continue call report_null_forcing_routine_error ( \"frf_modal_prop_damp\" , & errmgr ) return end function ! ------------------------------------------------------------------------------ function frf_modal_prop_damp_2 ( mass , stiff , alpha , beta , nfreq , freq1 , & freq2 , frc , modes , modeshapes , args , err ) result ( rst ) !! Computes the frequency response functions for a !! multi-degree-of-freedom system that uses proportional damping such !! that the damping matrix C is related to the stiffness an mass !! matrices by proportional damping coefficients \\alpha and !! \\beta by C = \\alpha M + \\beta K . use linalg , only : eigen , sort , mtx_mult , LA_NO_OPERATION , LA_TRANSPOSE use dynamics_error_handling real ( real64 ), intent ( in ), dimension (:,:) :: mass !! The N-by-N mass matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ), dimension (:,:) :: stiff !! The N-by-N stiffness matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ) :: alpha !! The mass damping factor, \\alpha . real ( real64 ), intent ( in ) :: beta !! The stiffness damping factor, \\beta . integer ( int32 ), intent ( in ) :: nfreq !! The number of frequency values to analyze. This value must be !! at least 2. real ( real64 ), intent ( in ) :: freq1 !! The starting frequency, in units of rad/s. real ( real64 ), intent ( in ) :: freq2 !! The ending frequency, in units of rad/s. procedure ( modal_excite ), pointer , intent ( in ) :: frc !! A pointer to a routine used to compute the modal forcing !! function. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:) :: modes !! An optional N-element allocatable array that, if supplied, will !! be used to retrieve the modal frequencies, in units of rad/s. real ( real64 ), intent ( out ), allocatable , optional , & dimension (:,:) :: modeshapes !! An optional N-by-N allocatable matrix that, if supplied, will be !! used to retrieve the N mode shapes with each vector occupying !! its own column. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to communicate with !! the outside world. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_MATRIX_SIZE_ERROR: Occurs if the mass or stiffness matrices !! are not square, or if the mass and stiffness matrices are !! different sized. !! - DYN_NULL_POINTER_ERROR: Occurs if the forcing function pointer !! is undefined. type ( frf ) :: rst !! The resulting frequency responses. ! Local Variables integer ( int32 ) :: i , flag real ( real64 ) :: df real ( real64 ), allocatable , dimension (:) :: freq class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if ! Input Checking if ( abs ( freq1 - freq2 ) < sqrt ( epsilon ( freq1 ))) then call report_zero_difference_error ( \"frf_modal_prop_damp_2\" , & \"freq1\" , freq1 , \"freq2\" , freq2 , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if if ( nfreq < 2 ) then call report_generic_counting_error ( \"frf_modal_prop_damp_2\" , & \"The number of frequency points must be at least 2, \" // & \"but was found to be \" , nfreq , \".\" , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if ! Process df = ( freq2 - freq1 ) / ( nfreq - 1.0d0 ) allocate ( freq ( nfreq ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"frf_modal_prop_damp_2\" , flag , errmgr ) return end if freq = ( / ( df * i + freq1 , i = 0 , nfreq - 1 ) / ) rst = frequency_response ( mass , stiff , alpha , beta , freq , frc , modes , & modeshapes , args = args , err = err ) end function ! ------------------------------------------------------------------------------ pure elemental function compute_modal_damping ( lambda , alpha , beta ) & result ( rst ) !! Computes the modal damping factors \\zeta_i given the !! proportional damping terms \\alpha and \\beta where !! \\alpha + \\beta \\omega_{i}^2 = 2 \\zeta_{i} \\omega_{i} , !! \\lambda_{i} = \\omega_{i}^2 , and \\lambda_i is the !! i^{th} eigenvalue of the system. real ( real64 ), intent ( in ) :: lambda !! The square of the modal frequency - the eigen value. real ( real64 ), intent ( in ) :: alpha !! The mass damping factor, \\alpha . real ( real64 ), intent ( in ) :: beta !! The stiffness damping factor, \\beta . real ( real64 ) rst !! The modal damping parameter. ! Local Variables integer ( int32 ) :: n ! Process rst = ( alpha + beta * lambda ) / ( 2.0d0 * sqrt ( lambda )) end function ! ------------------------------------------------------------------------------ subroutine modal_response ( mass , stiff , freqs , modeshapes , err ) !! Computes the modal frequencies and modes shapes for !! multi-degree-of-freedom system. use dynamics_error_handling use linalg , only : eigen , sort real ( real64 ), intent ( in ), dimension (:,:) :: mass !! The N-by-N mass matrix for the system. This matrix must be !! symmetric. real ( real64 ), intent ( in ), dimension (:,:) :: stiff !! The N-by-N stiffness matrix for the system. This matrix must !! be symmetric. real ( real64 ), intent ( out ), allocatable , dimension (:) :: freqs !! An allocatable N-element array where the modal frequencies will !! be returned in ascending order with units of rad/s. real ( real64 ), intent ( out ), allocatable , optional , dimension (:,:) :: & modeshapes !! An optional, allocatable N-by-N matrix where the N mode shapes !! for the system will be returned. The mode shapes are stored in !! columns. class ( errors ), intent ( inout ), optional , target :: err ! Local Variables integer ( int32 ) :: n , flag real ( real64 ), allocatable , dimension (:,:) :: mmtx , kmtx complex ( real64 ), allocatable , dimension (:) :: vals complex ( real64 ), allocatable , dimension (:,:) :: vecs class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( mass , 1 ) ! Input Checking if ( size ( mass , 2 ) /= n ) go to 10 if ( size ( stiff , 1 ) /= size ( stiff , 2 )) go to 20 if ( size ( stiff , 1 ) /= n . or . size ( stiff , 2 ) /= n ) go to 30 ! TO DO: Check for symmetry ! Memory allocations allocate ( mmtx ( n , n ), source = mass , stat = flag ) if ( flag == 0 ) allocate ( kmtx ( n , n ), source = stiff , stat = flag ) if ( flag == 0 ) allocate ( vals ( n ), stat = flag ) if ( flag == 0 . and . present ( modeshapes )) & allocate ( vecs ( n , n ), stat = flag ) if ( flag /= 0 ) go to 40 ! Solve the eigen problem if ( present ( modeshapes )) then call eigen ( kmtx , mmtx , vals , vecs = vecs , err = errmgr ) if ( errmgr % has_error_occurred ()) return call sort ( vals , vecs ) allocate ( modeshapes ( n , n ), source = real ( vecs ), stat = flag ) if ( flag /= 0 ) go to 40 else call eigen ( kmtx , mmtx , vals , err = errmgr ) if ( errmgr % has_error_occurred ()) return call sort ( vals ) end if ! Convert the eigenvalues to frequency values allocate ( freqs ( n ), source = sqrt ( abs ( real ( vals ))), & stat = flag ) if ( flag /= 0 ) go to 40 ! End return ! Non-square mass matrix error handler 10 continue call report_nonsquare_mass_matrix_error ( \"modal_response\" , & size ( mass , 1 ), size ( mass , 2 ), errmgr ) return ! Non-square stiffness matrix error handler 20 continue call report_nonsquare_stiffness_matrix_error ( \"modal_response\" , & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Stiffness and mass matrix size mismatch error handler 30 continue call report_matrix_size_mismatch_error ( \"modal_response\" , & \"mass\" , \"stiffness\" , size ( mass , 1 ), size ( mass , 2 ), & size ( stiff , 1 ), size ( stiff , 2 ), errmgr ) return ! Memory error handler 40 continue call report_memory_error ( \"modal_response\" , flag , errmgr ) return end subroutine ! ------------------------------------------------------------------------------ subroutine normalize_mode_shapes ( x ) !! Normalizes mode shape vectors such that the largest magnitude !! value in the vector is one. real ( real64 ), intent ( inout ), dimension (:,:) :: x !! The matrix of mode shape vectors with one vector per column. ! Local Variables integer ( int32 ) :: i , loc real ( real64 ) :: factor ! Process do i = 1 , size ( x , 2 ) loc = maxloc ( abs ( x (:, i )), 1 ) factor = x ( loc , i ) x (:, i ) = x (:, i ) / factor end do end subroutine ! ****************************************************************************** ! HARMONIC_ODE_CONTAINER ROUTINES ! ------------------------------------------------------------------------------ function frf_sweep_1 ( fcn , freq , iv , solver , ncycles , ntransient , & points , inHz , args , err ) result ( rst ) !! Computes the frequency response of each equation of a system of !! harmonically excited ODE's by sweeping through frequency. !! !! The amplitude and phase are determined by means of a harmonic !! projection method. !! !! Y = \\sqrt{a^{2} + b^{2}} !! \\phi = \\tan^{-1}{\\left( \\frac{a}{b} \\right)} !! !! where !! a = \\frac{2}{T} \\int y(t) \\cos{\\left(\\omega t \\right)} \\, dt !! b = \\frac{2}{T} \\int y(t) \\sin{\\left(\\omega t \\right)} \\, dt use diffeq , only : runge_kutta_45 use dynamics_error_handling procedure ( harmonic_ode ), pointer , intent ( in ) :: fcn !! A pointer to the routine containing the ODE's to integrate. real ( real64 ), intent ( in ), dimension (:) :: freq !! An M-element array containing the frequency points at which the !! solution should be computed. Notice, whatever units are utilized !! for this array are also the units of the excitation_frequency !! property in sys. Additionally, this array cannot contain any !! zero-valued elements as the ODE solution time for each frequency !! is determined by the period of oscillation and number of cycles. real ( real64 ), intent ( in ), dimension (:) :: iv !! An N-element array containing the initial conditions for each of !! the N ODEs. class ( ode_integrator ), intent ( inout ), optional , target :: solver !! An optional differential equation solver. The default solver !! is the Dormand-Prince Runge-Kutta integrator from the DIFFEQ !! library. integer ( int32 ), intent ( in ), optional :: ncycles !! An optional parameter controlling the number of cycles to !! analyze when determining the amplitude and phase of the response. !! The default is 5. integer ( int32 ), intent ( in ), optional :: ntransient !! An optional parameter controlling how many of the initial !! \"transient\" cycles to ignore. The default is 30. integer ( int32 ), intent ( in ), optional :: points !! An optional parameter controlling how many evenly spaced !! solution points should be considered per cycle. The default is !! 1000. logical , intent ( in ), optional :: inHz !! Set to true if the units of the frequency vector are in Hz. If !! false, the units are assumed as rad/s. The default is false such !! that the frequency units are assumed to be rad/s. class ( * ), intent ( inout ), optional :: args !! An optional argument allowing for passing of data in/out of the !! fcn subroutine. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. !! - DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter !! is given. !! - DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued !! frequency was supplied. type ( frf ) :: rst !! The resulting frequency responses. ! Parameters real ( real64 ), parameter :: zerotol = sqrt ( epsilon ( 0.0d0 )) real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) ! Local Variables logical :: hz integer ( int32 ) :: i , j , nfreq , neqn , nc , nt , ntotal , npts , ppc , flag , & i1 , ncpts real ( real64 ) :: dt , tare , phase , amp , omega , f real ( real64 ), allocatable , dimension (:) :: ic , t real ( real64 ), allocatable , dimension (:,:) :: sol type ( ode_container ) :: sys class ( ode_integrator ), pointer :: integrator type ( runge_kutta_45 ), target :: default_integrator class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( frf_arg_container ) :: container ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if if ( present ( ncycles )) then nc = ncycles else nc = 5 end if if ( present ( ntransient )) then nt = ntransient else nt = 30 end if if ( present ( points )) then ppc = points else ppc = 1000 end if if ( present ( inHz )) then hz = inHz else hz = . false . end if nfreq = size ( freq ) neqn = size ( iv ) ntotal = nt + nc npts = ntotal * ppc ncpts = nc * ppc i1 = npts - ncpts + 1 sys % fcn => sweep_eom ! Set up the optional argument container container % fcn => fcn container % uses_optional_args = present ( args ) if ( present ( args )) then allocate ( container % optional_args , source = args ) end if ! Set up the integrator if ( present ( solver )) then integrator => solver else integrator => default_integrator end if ! Input Checking if ( nc < 1 ) go to 20 if ( nt < 1 ) go to 30 if ( ppc < 2 ) go to 40 do i = 1 , nfreq if ( abs ( freq ( i )) < zerotol ) go to 50 end do ! Local Memory Allocation allocate ( rst % responses ( nfreq , neqn ), stat = flag ) if ( flag == 0 ) allocate ( rst % frequency ( nfreq ), source = freq , & stat = flag ) if ( flag == 0 ) allocate ( ic ( neqn ), stat = flag , source = iv ) if ( flag == 0 ) allocate ( t ( npts ), stat = flag ) if ( flag /= 0 ) go to 10 ! Cycle over each frequency point do i = 1 , nfreq ! Define the time vector if ( hz ) then f = freq ( i ) omega = 2.0d0 * pi * f else omega = freq ( i ) f = omega / ( 2.0d0 * pi ) end if dt = ( 1.0d0 / f ) / ( ppc - 1.0d0 ) t = ( / ( dt * j , j = 0 , npts - 1 ) / ) ! Set the frequency container % frequency = freq ( i ) ! Compute the solution call integrator % solve ( sys , t , ic , args = container , err = errmgr ) if ( errmgr % has_error_occurred ()) return sol = integrator % get_solution () ! Reset the initial conditions to the last solution point ic = sol ( npts , 2 :) ! Determine the magnitude and phase for each equation do j = 1 , neqn rst % responses ( i , j ) = & harmonic_projection ( omega , sol ( i1 : npts , 1 ), & sol ( i1 : npts , j + 1 )) end do ! Clear the solution buffer for the next time around call integrator % clear_buffer () end do ! End return ! Memory Error 10 continue call report_memory_error ( \"frf_sweep_1\" , flag , errmgr ) return ! Number of Cycles Error 20 continue call report_generic_counting_error ( \"frf_sweep_1\" , & \"The number of cycles to analyze must be at least 1; \" // & \"however, a value of \" , nc , \" was found.\" , & DYN_INVALID_INPUT_ERROR , errmgr ) return ! Number of Transient Cycles Error 30 continue call report_generic_counting_error ( \"frf_sweep_1\" , & \"The number of transient cycles must be at least 1; \" // & \"however, a value of \" , nt , \" was found.\" , & DYN_INVALID_INPUT_ERROR , errmgr ) return ! Points Per Cycle Error 40 continue call report_generic_counting_error ( \"frf_sweep_1\" , & \"The number of points per cycle must be at least 2; \" // & \"however, a value of \" , ppc , \" was found.\" , & DYN_INVALID_INPUT_ERROR , errmgr ) return ! Zero-Valued Frequency Error 50 continue call report_zero_valued_frequency_error ( \"frf_sweep_1\" , i , errmgr ) return end function ! ---------- subroutine sweep_eom ( x , y , dydx , args ) real ( real64 ), intent ( in ) :: x real ( real64 ), intent ( in ), dimension (:) :: y real ( real64 ), intent ( out ), dimension (:) :: dydx class ( * ), intent ( inout ), optional :: args select type ( args ) class is ( frf_arg_container ) if ( args % uses_optional_args ) then call args % fcn ( args % frequency , x , y , dydx , args % optional_args ) else call args % fcn ( args % frequency , x , y , dydx ) end if end select end subroutine ! ---------- pure function harmonic_projection ( omega , t , y ) result ( rst ) real ( real64 ), intent ( in ) :: omega real ( real64 ), intent ( in ), dimension (:) :: t real ( real64 ), intent ( in ), dimension ( size ( t )) :: y complex ( real64 ) :: rst ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: a , b , r , phi ! Initialization n = size ( t ) a = 0.0d0 b = 0.0d0 ! Process do i = 1 , n a = a + y ( i ) * cos ( omega * t ( i )) b = b + y ( i ) * sin ( omega * t ( i )) end do a = 2.0d0 * a / n b = 2.0d0 * b / n r = sqrt ( a ** 2 + b ** 2 ) phi = atan2 ( a , b ) rst = cmplx ( r * cos ( phi ), r * sin ( phi )) end function ! ------------------------------------------------------------------------------ function frf_sweep_2 ( fcn , nfreq , freq1 , freq2 , iv , solver , ncycles , & ntransient , points , inHz , args , err ) result ( rst ) !! Computes the frequency response of each equation of a system of !! harmonically excited ODE's by sweeping through frequency. !! !! The amplitude and phase are determined by means of a harmonic !! projection method. !! !! Y = \\sqrt{a^{2} + b^{2}} !! \\phi = \\tan^{-1}{\\left( \\frac{a}{b} \\right)} !! !! where !! a = \\frac{2}{T} \\int y(t) \\cos{\\left(\\omega t \\right)} \\, dt !! b = \\frac{2}{T} \\int y(t) \\sin{\\left(\\omega t \\right)} \\, dt use diffeq , only : runge_kutta_45 use dynamics_error_handling procedure ( harmonic_ode ), pointer , intent ( in ) :: fcn !! A pointer to the routine containing the ODE's to integrate. integer ( int32 ), intent ( in ) :: nfreq !! The number of frequency values to analyze. This value must be !! at least 2. real ( real64 ), intent ( in ) :: freq1 !! The starting frequency. real ( real64 ), intent ( in ) :: freq2 !! The ending frequency. real ( real64 ), intent ( in ), dimension (:) :: iv !! An N-element array containing the initial conditions for each of !! the N ODEs. class ( ode_integrator ), intent ( inout ), optional , target :: solver !! An optional differential equation solver. The default solver !! is the Dormand-Prince Runge-Kutta integrator from the DIFFEQ !! library. integer ( int32 ), intent ( in ), optional :: ncycles !! An optional parameter controlling the number of cycles to !! analyze when determining the amplitude and phase of the response. !! The default is 5. integer ( int32 ), intent ( in ), optional :: ntransient !! An optional parameter controlling how many of the initial !! \"transient\" cycles to ignore. The default is 30. integer ( int32 ), intent ( in ), optional :: points !! An optional parameter controlling how many evenly spaced !! solution points should be considered per cycle. The default is !! 1000. logical , intent ( in ), optional :: inHz !! Set to true if the units of the frequency units are in Hz. If !! false, the units are assumed as rad/s. The default is false such !! that the frequency units are assumed to be rad/s. class ( * ), intent ( inout ), optional :: args !! An optional argument allowing for passing of data in/out of the !! fcn subroutine. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! - DYN_NULL_POINTER_ERROR: Occurs if a null pointer is supplied. !! - DYN_INVALID_INPUT_ERROR: Occurs if an invalid parameter !! is given. !! - DYN_ZERO_VALUED_FREQUENCY_ERROR: Occurs if a zero-valued !! frequency was supplied. type ( frf ) :: rst !! The resulting frequency responses. ! Local Variables integer ( int32 ) :: i , flag real ( real64 ) :: df real ( real64 ), allocatable , dimension (:) :: freq class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if ! Input Checking if ( abs ( freq1 - freq2 ) < sqrt ( epsilon ( freq1 ))) then call report_zero_difference_error ( \"hoc_frf_sweep_2\" , & \"freq1\" , freq1 , \"freq2\" , freq2 , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if if ( nfreq < 2 ) then call report_generic_counting_error ( \"hoc_frf_sweep_2\" , & \"The number of frequency points must be at least 2, \" // & \"but was found to be \" , nfreq , \".\" , DYN_INVALID_INPUT_ERROR , & errmgr ) return end if ! Process df = ( freq2 - freq1 ) / ( nfreq - 1.0d0 ) allocate ( freq ( nfreq ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"hoc_frf_sweep_2\" , flag , errmgr ) return end if freq = ( / ( df * i + freq1 , i = 0 , nfreq - 1 ) / ) rst = frf_sweep_1 ( fcn , freq , iv , solver , ncycles , ntransient , & points , inHz = inHz , args = args , err = err ) end function ! ****************************************************************************** ! VERSION 1.0.5 ADDITIONS ! ------------------------------------------------------------------------------ function siso_freqres ( x , y , fs , win , method , err ) result ( rst ) !! Estimates the frequency response of a single-input, single-output (SISO) !! system. real ( real64 ), intent ( in ), dimension (:) :: x !! An N-element array containing the excitation signal. real ( real64 ), intent ( in ), dimension (:) :: y !! An N-element array containing the response signal. real ( real64 ), intent ( in ) :: fs !! The sampling frequency, in Hz. class ( window ), intent ( in ), optional , target :: win !! The window to apply to the data. If nothing is supplied, no window !! is applied. integer ( int32 ), intent ( in ), optional :: method !! Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an !! H2 estimator. The default is an H1 estimator. !! !! An H1 estimator is defined as the cross-spectrum of the input and !! response signals divided by the energy spectral density of the input. !! An H2 estimator is defined as the energy spectral density of the !! response divided by the cross-spectrum of the input and response !! signals. !! !! H_{1} = \\frac{P_{xy}}{P_{xx}} !! !! H_{2} = \\frac{P_{yy}}{P_{xy}} class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! !! - DYN_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size. type ( frf ) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , npts , nfreq , meth , flag real ( real64 ) :: df class ( window ), pointer :: wptr type ( rectangular_window ), target :: defwin class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if npts = size ( x ) if ( present ( win )) then wptr => win else defwin % size = npts wptr => defwin end if if ( present ( method )) then if ( method == 2 ) then meth = SPCTRM_H2_ESTIMATOR else meth = SPCTRM_H1_ESTIMATOR end if else meth = SPCTRM_H1_ESTIMATOR end if nfreq = compute_transform_length ( wptr % size ) allocate ( rst % frequency ( nfreq ), stat = flag ) if ( flag == 0 ) allocate ( rst % responses ( nfreq , 1 ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"siso_freqres\" , flag , errmgr ) return end if ! Input Checking if ( size ( y ) /= npts ) then call report_array_size_error ( \"siso_freqres\" , \"y\" , npts , size ( y ), errmgr ) return end if ! Compute the transfer function rst % responses (:, 1 ) = siso_transfer_function ( wptr , x , y , etype = meth ) ! Compute the frequency vector df = frequency_bin_width ( fs , wptr % size ) rst % frequency = ( / ( df * i , i = 0 , nfreq - 1 ) / ) end function ! ------------------------------------------------------------------------------ function mimo_freqres ( x , y , fs , win , method , err ) result ( rst ) !! Estimates the frequency responses of a multiple-input, multiple-output !! (MIMO) system. real ( real64 ), intent ( in ), dimension (:,:) :: x !! An N-by-P array containing the P inputs to the system. real ( real64 ), intent ( in ), dimension (:,:) :: y !! An N-by-M array containing the M outputs from the system. real ( real64 ), intent ( in ) :: fs !! The sampling frequency, in Hz. class ( window ), intent ( in ), optional , target :: win !! The window to apply to the data. If nothing is supplied, no window !! is applied. integer ( int32 ), intent ( in ), optional :: method !! Enter 1 to utilize an H1 estimator; else, enter 2 to utilize an !! H2 estimator. The default is an H1 estimator. !! !! An H1 estimator is defined as the cross-spectrum of the input and !! response signals divided by the energy spectral density of the input. !! An H2 estimator is defined as the energy spectral density of the !! response divided by the cross-spectrum of the input and response !! signals. !! !! H_{1} = \\frac{P_{xy}}{P_{xx}} !! !! H_{2} = \\frac{P_{yy}}{P_{xy}} class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! !! - DYN_ARRAY_SIZE_ERROR: Occurs if x and y do not have the same number !! of rows. type ( mimo_frf ) :: rst !! The resulting frequency response functions. ! Local Variables integer ( int32 ) :: i , j , npts , m , p , nfreq , meth , flag real ( real64 ) :: df class ( window ), pointer :: wptr type ( rectangular_window ), target :: defwin class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if npts = size ( x , 1 ) m = size ( y , 2 ) p = size ( x , 2 ) if ( present ( win )) then wptr => win else defwin % size = npts wptr => defwin end if if ( present ( method )) then if ( method == 2 ) then meth = SPCTRM_H2_ESTIMATOR else meth = SPCTRM_H1_ESTIMATOR end if else meth = SPCTRM_H1_ESTIMATOR end if nfreq = compute_transform_length ( wptr % size ) allocate ( rst % frequency ( nfreq ), stat = flag ) if ( flag == 0 ) allocate ( rst % responses ( nfreq , m , p )) if ( flag /= 0 ) then call report_memory_error ( \"mimo_freqres\" , flag , errmgr ) return end if ! Input Checking if ( size ( y , 1 ) /= npts ) then call report_matrix_size_error ( \"mimo_freqres\" , \"y\" , npts , size ( y , 2 ), & size ( y , 1 ), size ( y , 2 ), errmgr ) return end if ! Compute the transfer functions for each possible combination do j = 1 , p do i = 1 , m rst % responses (:, i , j ) = siso_transfer_function ( wptr , & x (:, j ), y (:, i ), etype = meth ) end do end do ! Compute the frequency vector df = frequency_bin_width ( fs , wptr % size ) rst % frequency = ( / ( df * i , i = 0 , nfreq - 1 ) / ) end function ! ****************************************************************************** ! V1.0.6 ADDITIONS ! ------------------------------------------------------------------------------ ! SEE: https://www.researchgate.net/publication/224619803_Reduction_of_structure-borne_noise_in_automobiles_by_multivariable_feedback subroutine frf_accel_fit_fcn ( xdata , mdl , rst , stop , args ) !! The FRF fitting function for an accelerance FRF (acceleration-excited). real ( real64 ), intent ( in ), dimension (:) :: xdata !! The independent variable data. real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameters. real ( real64 ), intent ( out ), dimension (:) :: rst !! The model results. logical , intent ( out ) :: stop !! Stop the simulation? class ( * ), intent ( inout ), optional :: args !! Optional arguments from the calling code. ! Local Variables integer ( int32 ) :: i , n complex ( real64 ) :: h ! Process: ! ! The amplitude portion of the response is stored in the first \"N\" locations ! in the output with the phase portion (in radians) is stored in the ! second \"N\" locations. n = size ( xdata ) / 2 do i = 1 , n h = evaluate_accelerance_frf_model ( mdl , xdata ( i )) rst ( i ) = abs ( h ) rst ( i + n ) = atan2 ( aimag ( h ), real ( h )) end do end subroutine ! ------------------------------------------------------------------------------ subroutine frf_force_fit_fcn ( xdata , mdl , rst , stop , args ) !! The FRF fitting function for an force-excited FRF. real ( real64 ), intent ( in ), dimension (:) :: xdata !! The independent variable data. real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameters. real ( real64 ), intent ( out ), dimension (:) :: rst !! The model results. logical , intent ( out ) :: stop !! Stop the simulation? class ( * ), intent ( inout ), optional :: args !! Optional arguments from the calling code. ! Local Variables integer ( int32 ) :: i , n complex ( real64 ) :: h ! Process: ! ! The amplitude portion of the response is stored in the first \"N\" locations ! in the output with the phase portion (in radians) is stored in the ! second \"N\" locations. n = size ( xdata ) / 2 do i = 1 , n h = evaluate_receptance_frf_model ( mdl , xdata ( i )) rst ( i ) = abs ( h ) rst ( i + n ) = atan2 ( aimag ( h ), real ( h )) end do end subroutine ! ------------------------------------------------------------------------------ function fit_frf ( mt , n , freq , rsp , maxp , minp , init , stats , alpha , controls , & settings , info , err ) result ( rst ) use peaks !! Fits an experimentally obtained frequency response by model for either a !! receptance model: !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{A_{i}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} !! !! or an accelerance model: !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{-A_{i} \\omega^{2}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} . !! !! Internally, the code uses a Levenberg-Marquardt solver to determine the !! parameters. The initial guess for the solver is determined by a !! peak finding algorithm used to locate the resonant modes in frequency. !! from this result, estimates for both the amplitude and natural frequency !! values are obtained. The damping parameters are assumed to be equal !! for all modes and set to a default value of 0.1. integer ( int32 ), intent ( in ) :: mt !! The excitation method. The options are as follows. !! !! - FRF_ACCELERANCE_MODEL: Use an accelerance model. !! !! - FRF_RECEPTANCE_MODEL: Use a receptance model. integer ( int32 ), intent ( in ) :: n !! The model order (# of resonant modes). real ( real64 ), intent ( in ), dimension (:) :: freq !! An M-element array containing the excitation frequency values in !! units of rad/s. complex ( real64 ), intent ( in ), dimension (:) :: rsp !! An M-element array containing the frequency response to fit. real ( real64 ), intent ( in ), dimension (:), optional :: maxp !! An optional 3*N-element array that can be used as upper limits on !! the parameter values. If no upper limit is requested for a particular !! parameter, utilize a very large value. The internal default is to !! utilize huge() as a value. real ( real64 ), intent ( in ), dimension (:), optional :: minp !! An optional 3*N-element array that can be used as lower limits on !! the parameter values. If no lower limit is requested for a particalar !! parameter, utilize a very large magnitude, but negative, value. The !! internal default is to utilize -huge() as a value. real ( real64 ), intent ( in ), dimension (:), optional :: init !! An optional 3*N-element array that, if supplied, provides an initial !! guess for each of the 3*N model parameters for the iterative solver. !! If supplied, this array replaces the peak finding algorithm for !! estimating an initial guess. type ( regression_statistics ), intent ( out ), dimension (:), optional :: stats !! An optional 3*N-element array that, if supplied, will be used to !! return statistics about the fit for each model parameter. real ( real64 ), intent ( in ), optional :: alpha !! The significance level at which to evaluate the confidence intervals. !! The default value is 0.05 such that a 95% confidence interval is !! calculated. type ( iteration_controls ), intent ( in ), optional :: controls !! An optional input providing custom iteration controls. type ( lm_solver_options ), intent ( in ), optional :: settings !! An optional input providing custom settings for the solver. type ( convergence_info ), intent ( out ), optional :: info !! An optional output that can be used to gain information about the !! iterative solution and the nature of the convergence. class ( errors ), intent ( inout ), optional , target :: err !! An optional errors-based object that if provided !! can be used to retrieve information relating to any errors !! encountered during execution. If not provided, a default !! implementation of the errors class is used internally to provide !! error handling. Possible errors and warning messages that may be !! encountered are as follows. !! !! - DYN_MEMORY_ERROR: Occurs if there are issues allocating memory. !! !! - DYN_ARRAY_SIZE_ERROR: Occurs if freq and rsp are not the same size. !! !! - DYN_UNDERDEFINED_PROBLEM_EROR: Occurs if the requested model !! order is too high for the number of data points available. !! !! - DYN_TOLERANCE_TOO_SMALL_ERROR: Occurs if the requested solver !! tolerance is too small to be practical for this problem. !! !! - DYN_TOO_FEW_ITERATIONS_ERROR: Occurs if convergence cannot be !! achieved in the allowed number of solver iterations. real ( real64 ), allocatable , dimension (:) :: rst !! An array containing the model parameters stored as \\left[ A_{1}, !! \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, \\zeta_{2} ... \\right] . ! Parameters real ( real64 ), parameter :: zeta = 0.1d0 ! Local Variables class ( errors ), pointer :: errmgr type ( errors ), target :: deferr procedure ( regression_function ), pointer :: fcn integer ( int32 ) :: i , npts , nparam , flag integer ( int32 ), allocatable , dimension (:) :: maxinds , mininds real ( real64 ) :: maxamp , minamp , amprange , delta real ( real64 ), allocatable , dimension (:) :: x , y , maxvals , minvals , & ymod , resid ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if select case ( mt ) case ( FRF_ACCELERANCE_MODEL ) fcn => frf_accel_fit_fcn case ( FRF_RECEPTANCE_MODEL ) fcn => frf_force_fit_fcn case default call errmgr % report_error ( \"fit_frf\" , \"Invalid entry for the \" // & \"variable mt. Must be either FRF_ACCELERANCE_MODEL or \" // & \"FRF_RECEPTANCE_MODEL.\" , DYN_INVALID_INPUT_ERROR ) return end select npts = size ( freq ) nparam = 3 * n ! Input Checking if ( size ( rsp ) /= npts ) then call report_array_size_error ( \"fit_frf\" , \"rsp\" , npts , size ( rsp ), errmgr ) return end if ! Memory Allocations allocate ( rst ( nparam ), stat = flag ) if ( flag == 0 ) allocate ( & x ( 2 * npts ), & y ( 2 * npts ), & ymod ( 2 * npts ), & resid ( 2 * npts ), & stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"fit_frf\" , flag , errmgr ) return end if ! Determine phase and amplitude terms, and store frequency values do i = 1 , npts ! Store frequency values x ( i ) = freq ( i ) x ( i + npts ) = freq ( i ) ! Store amplitude and phase values y ( i ) = abs ( rsp ( i )) y ( i + npts ) = atan2 ( aimag ( rsp ( i )), real ( rsp ( i ))) ! Determine max and min amplitudes if ( i == 1 ) then maxamp = y ( i ) minamp = y ( i ) else if ( y ( i ) > maxamp ) maxamp = y ( i ) if ( y ( i ) < minamp ) minamp = y ( i ) end if end do amprange = maxamp - minamp if ( present ( init )) then ! Check the array size if ( size ( init ) /= nparam ) then call report_array_size_error ( \"fit_frf\" , \"init\" , nparam , & size ( init ), errmgr ) return end if ! Copy init to rst rst = init else ! Perform the peak location to determine an initial guess at parameters delta = 0.005d0 * amprange call peak_detect ( y ( 1 : npts ), delta , maxinds , maxvals , mininds , minvals ) do i = 1 , min ( n , size ( maxvals )) rst ( 3 * i - 2 ) = maxvals ( i ) ! amplitude rst ( 3 * i - 1 ) = freq ( maxinds ( i )) ! frequency rst ( 3 * i ) = zeta ! damping end do if ( size ( maxvals ) < n ) then ! The peak detection did not find enough peaks. if ( size ( maxvals ) == 0 ) then ! No peaks found. This is suspicious, but just use a random ! estimate to get started. Maybe the solver will be able ! to sort it out. call random_number ( rst ) else ! Fill in the remaining parameters with the last set estimate do i = size ( maxvals ) + 1 , n rst ( 3 * i - 2 ) = rst ( 3 * ( i - 1 ) - 2 ) rst ( 3 * i - 1 ) = rst ( 3 * ( i - 1 ) - 1 ) rst ( 3 * i ) = rst ( 3 * ( i - 1 )) end do end if end if end if ! Fit the model call nonlinear_least_squares ( fcn , x , y , rst , ymod , resid , maxp = maxp , & minp = minp , stats = stats , alpha = alpha , controls = controls , & settings = settings , info = info , err = errmgr ) end function ! ------------------------------------------------------------------------------ pure function evaluate_accelerance_frf_model_scalar ( mdl , w ) result ( rst ) !! Evaluates the specified accelerance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{-A_{i} \\omega^{2}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , j , n ! Process j = 1 n = size ( mdl ) / 3 rst = ( 0.0d0 , 0.0d0 ) do i = 1 , n rst = rst + frf_accel_model_driver ( mdl ( j ), mdl ( j + 1 ), mdl ( j + 2 ), w ) j = j + 3 end do end function ! ---------- pure function evaluate_accelerance_frf_model_array ( mdl , w ) result ( rst ) !! Evaluates the specified accelerance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{-A_{i} \\omega^{2}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ), dimension (:) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ), allocatable , dimension (:) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , n ! Process n = size ( w ) allocate ( rst ( n )) do i = 1 , n rst ( i ) = evaluate_accelerance_frf_model_scalar ( mdl , w ( i )) end do end function ! ---------- pure elemental function frf_accel_model_driver ( A , wn , zeta , w ) result ( rst ) !! Evaluates a single term of the accelerance FRF model. real ( real64 ), intent ( in ) :: A !! The amplitude term. real ( real64 ), intent ( in ) :: wn !! The natural frequency term. real ( real64 ), intent ( in ) :: zeta !! The damping ratio term. real ( real64 ), intent ( in ) :: w !! The excitation frequency. complex ( real64 ) :: rst !! The result. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) ! Process rst = - A * w ** 2 / ( wn ** 2 - w ** 2 + 2.0d0 * j * zeta * wn * w ) end function ! ------------------------------------------------------------------------------ pure function evaluate_receptance_frf_model_scalar ( mdl , w ) result ( rst ) !! Evaluates the specified receptance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{A_{i}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , j , n ! Process j = 1 n = size ( mdl ) / 3 rst = ( 0.0d0 , 0.0d0 ) do i = 1 , n rst = rst + frf_receptance_model_driver ( mdl ( j ), mdl ( j + 1 ), mdl ( j + 2 ), w ) j = j + 3 end do end function ! ---------- pure function evaluate_receptance_frf_model_array ( mdl , w ) result ( rst ) !! Evaluates the specified receptance FRF model. The model is of !! the following form. !! !! H(\\omega) = \\sum_{i=1}^{n} \\frac{A_{i}}{\\omega_{ni}^{2} - !! \\omega^{2} + 2 j \\zeta_{i} \\omega_{ni} \\omega} real ( real64 ), intent ( in ), dimension (:) :: mdl !! The model parameter array. The elements of the array are stored !! as \\left[ A_{1}, \\omega_{n1}, \\zeta_{1}, A_{2}, \\omega_{n2}, !! \\zeta_{2} ... \\right] . real ( real64 ), intent ( in ), dimension (:) :: w !! The frequency value, in rad/s, at which to evaluate the model. complex ( real64 ), allocatable , dimension (:) :: rst !! The resulting frequency response function. ! Local Variables integer ( int32 ) :: i , n ! Process n = size ( w ) allocate ( rst ( n )) do i = 1 , n rst ( i ) = evaluate_receptance_frf_model_scalar ( mdl , w ( i )) end do end function ! ---------- pure elemental function frf_receptance_model_driver ( A , wn , zeta , w ) result ( rst ) !! Evaluates a single term of the receptance FRF model. real ( real64 ), intent ( in ) :: A !! The amplitude term. real ( real64 ), intent ( in ) :: wn !! The natural frequency term. real ( real64 ), intent ( in ) :: zeta !! The damping ratio term. real ( real64 ), intent ( in ) :: w !! The excitation frequency. complex ( real64 ) :: rst !! The result. ! Parameters complex ( real64 ), parameter :: j = ( 0.0d0 , 1.0d0 ) ! Process rst = A / ( wn ** 2 - w ** 2 + 2.0d0 * j * zeta * wn * w ) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_frequency_response.f90.html"},{"title":"dynamics_geometry.f90 – DYNAMICS","text":"Contents Modules dynamics_geometry Source Code dynamics_geometry.f90 Source Code module dynamics_geometry use iso_fortran_env use dynamics_helper use ieee_arithmetic use lapack , only : DGESVD , DGELSY use fstats , only : mean implicit none private public :: plane public :: plane_normal public :: line public :: plucker_line public :: assignment ( = ) public :: is_parallel public :: is_point_on_plane public :: is_point_on_line public :: nearest_point_on_line public :: point_to_line_distance public :: point_to_plane_distance public :: vector_plane_projection public :: point_plane_projection public :: matmul public :: line_from_point_and_vector public :: line_common_normal public :: do_lines_intersect type :: plane !! Defines a plane as a x + b y + c z + d = 0 . real ( real64 ) :: a !! The x-component of the plane normal vector. real ( real64 ) :: b !! The y-component of the plane normal vector. real ( real64 ) :: c !! The z-component of the plane normal vector. real ( real64 ) :: d !! The offset from the origin. contains procedure , public :: flip_normal => plane_flip_normal end type interface plane module procedure :: plane_from_3pts module procedure :: plane_from_point_and_normal module procedure :: plane_from_many_points end interface type :: line !! Defines the parametric form of a line !! \\vec{r} = \\vec{r_o} + t \\vec{v} . real ( real64 ) :: r0 ( 3 ) !! The coordinates of the initial point \\vec{r_o}. real ( real64 ) :: v ( 3 ) !! The vector defining the orientation of the line. contains procedure , public :: evaluate => line_eval end type interface line module procedure :: line_from_2pts module procedure :: line_from_2_planes module procedure :: line_from_many_points end interface interface assignment ( = ) module procedure :: plane_assign module procedure :: line_assign module procedure :: pl_assign module procedure :: pl_assign_line end interface interface is_parallel module procedure :: is_parallel_vectors module procedure :: is_parallel_lines module procedure :: is_parallel_planes end interface type :: plucker_line !! Defines a line in 3D Euclidean space using Plücker coordinates. real ( real64 ), public :: v ( 6 ) !! The 6-element array containing the Plücker coordinates. The !! first 3 elements contain the unit vector and the last 3 elements !! contain the moment vector. contains procedure , public :: u => pl_u procedure , public :: m => pl_m procedure , public :: to_array => pl_to_array end type interface plucker_line module procedure :: pl_from_2pts module procedure :: pl_from_line module procedure :: pl_from_2_planes module procedure :: pl_from_array end interface interface matmul module procedure :: pl_matmul end interface contains ! ****************************************************************************** ! PLANE ROUTINES ! ------------------------------------------------------------------------------ pure function plane_normal ( pln ) result ( rst ) !! Returns the normal vector of a plane. type ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ) :: rst ( 3 ) !! The normal vector. rst = [ pln % a , pln % b , pln % c ] rst = rst / norm2 ( rst ) end function ! ------------------------------------------------------------------------------ pure function plane_from_3pts ( pt1 , pt2 , pt3 ) result ( rst ) !! Constructs a plane from 3 points. The 3 points must not be colinear. real ( real64 ), intent ( in ) :: pt1 ( 3 ) !! The first point. real ( real64 ), intent ( in ) :: pt2 ( 3 ) !! The second point. real ( real64 ), intent ( in ) :: pt3 ( 3 ) !! The third point. type ( plane ) :: rst !! The resulting plane. real ( real64 ) :: ab ( 3 ), ac ( 3 ), nrm ( 3 ) ab = pt2 - pt1 ac = pt3 - pt1 nrm = cross_product ( ab , ac ) nrm = nrm / norm2 ( nrm ) rst = plane_from_point_and_normal ( pt1 , nrm ) end function ! ------------------------------------------------------------------------------ pure function plane_from_point_and_normal ( pt , nrm ) result ( rst ) !! Constructs a plane from a point which lies on the plane, and a !! unit vector normal to the plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point that lies on the plane. real ( real64 ), intent ( in ) :: nrm ( 3 ) !! The normal unit vector. type ( plane ) :: rst !! The resulting plane. real ( real64 ) :: nmag nmag = norm2 ( nrm ) rst % a = nrm ( 1 ) / nmag rst % b = nrm ( 2 ) / nmag rst % c = nrm ( 3 ) / nmag rst % d = - rst % a * pt ( 1 ) - rst % b * pt ( 2 ) - rst % c * pt ( 3 ) end function ! ------------------------------------------------------------------------------ pure function plane_from_many_points ( pts ) result ( rst ) !! Constructs the plane that best fits a cloud of points in a !! least-squares sense. real ( real64 ), intent ( in ), dimension (:,:) :: pts !! The N-by-3 matrix containing the N points to fit. N must be !! at least 3, but is typically much larger. type ( plane ) :: rst !! The resulting plane. ! Local Variables character :: jobu , jobvt integer ( int32 ) :: i , m , n , mn , lwork , info real ( real64 ), allocatable , dimension (:,:) :: shifted , vt real ( real64 ), allocatable , dimension (:) :: s , work real ( real64 ) :: temp ( 1 ), dummy ( 1 ), avg ( 3 ), nrm ( 3 ), nan ! Initialization jobu = 'N' jobvt = 'S' m = size ( pts , 1 ) n = size ( pts , 2 ) mn = min ( m , n ) nan = ieee_value ( nan , IEEE_QUIET_NAN ) ! Input Checking if ( m < 3 . or . n /= 3 ) then rst % a = nan rst % b = nan rst % c = nan rst % d = nan return end if ! Workspaec Sizing - only compute V**T call DGESVD ( jobu , jobvt , m , n , dummy , m , dummy , dummy , m , dummy , mn , & temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork ), vt ( mn , n ), shifted ( m , n ), s ( mn )) ! Process if ( m == 3 ) then ! An exact fit from 3 points rst = plane ( pts ( 1 ,:), pts ( 2 ,:), pts ( 3 ,:)) else avg ( 1 ) = mean ( pts (:, 1 )) avg ( 2 ) = mean ( pts (:, 2 )) avg ( 3 ) = mean ( pts (:, 3 )) do i = 1 , m shifted ( i ,:) = pts ( i ,:) - avg end do call DGESVD ( jobu , jobvt , m , n , shifted , m , s , dummy , m , vt , mn , & work , lwork , info ) if ( info /= 0 ) then rst % a = nan rst % b = nan rst % c = nan rst % d = nan return end if nrm = vt ( 3 ,:) nrm = nrm / norm2 ( nrm ) rst = plane ( avg , nrm ) end if end function ! ------------------------------------------------------------------------------ ! LINE MEMBER ROUTINES ! ------------------------------------------------------------------------------ subroutine plane_flip_normal ( this ) !! Flips the normal vector of the plane. class ( plane ), intent ( inout ) :: this !! The plane. ! Process this % a = - this % a this % b = - this % b this % c = - this % c end subroutine ! ------------------------------------------------------------------------------ ! PLANE OPERATORS ! ------------------------------------------------------------------------------ pure elemental subroutine plane_assign ( x , y ) !! Assigns a plane to another. type ( plane ), intent ( out ) :: x !! The resulting plane. type ( plane ), intent ( in ) :: y !! The source plane x % a = y % a x % b = y % b x % c = y % c x % d = y % d end subroutine ! ****************************************************************************** ! LINE ROUTINES ! ------------------------------------------------------------------------------ pure function line_from_2pts ( pt1 , pt2 ) result ( rst ) !! Constructs a line from two points. real ( real64 ), intent ( in ) :: pt1 ( 3 ) !! The first point. This point will act as the initial point !! along the line such that \\vec{r_o} = \\vec{pt_1} in the !! equation of the line \\vec{r} = \\vec{r_o} + t \\vec{v} . real ( real64 ), intent ( in ) :: pt2 ( 3 ) !! The second point. type ( line ) :: rst !! The resulting line. rst % r0 = pt1 rst % v = pt2 - pt1 end function ! ------------------------------------------------------------------------------ pure function line_from_2_planes ( p1 , p2 ) result ( rst ) !! Constructs a line from the intersection of two planes. class ( plane ), intent ( in ) :: p1 !! The first plane. class ( plane ), intent ( in ) :: p2 !! The second plane. type ( line ) :: rst !! The resulting line. NaN's are returned in the event that the !! two planes are parallel. ! Local Variables integer ( int32 ) :: ind real ( real64 ) :: n1 ( 3 ), n2 ( 3 ), a11 , a12 , a21 , a22 , b1 , b2 , & denom , x1 , x2 ! Compute the normal vectors of each plane n1 = plane_normal ( p1 ) n2 = plane_normal ( p2 ) ! Test to see if the planes are parallel if ( is_parallel ( n1 , n2 )) then rst % r0 = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) rst % v = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) return end if ! Obtain the direction of the line rst % v = cross_product ( n1 , n2 ) ! Find a point on the line. The idea is to first locate the index of ! the largest magnitue value in the direction vector. This component ! will cross zero at some point, and it is this point we seek to find. ind = maxloc ( abs ( rst % v ), 1 ) select case ( ind ) case ( 1 ) a11 = p1 % b a21 = p2 % b a12 = p1 % c a22 = p2 % c case ( 2 ) a11 = p1 % a a21 = p2 % a a12 = p1 % c a22 = p2 % c case default a11 = p1 % a a21 = p2 % a a12 = p1 % b a22 = p2 % b end select b1 = - p1 % d b2 = - p2 % d ! Solve the linear system denom = a11 * a22 - a12 * a21 x1 = ( a22 * b1 - a12 * b2 ) / denom x2 = ( a11 * b2 - a21 * b1 ) / denom ! Find a point along the line to call t = 0 select case ( ind ) case ( 1 ) rst % r0 ( 1 ) = 0.0d0 rst % r0 ( 2 ) = x1 rst % r0 ( 3 ) = x2 case ( 2 ) rst % r0 ( 1 ) = x1 rst % r0 ( 2 ) = 0.0d0 rst % r0 ( 3 ) = x2 case default rst % r0 ( 1 ) = x1 rst % r0 ( 2 ) = x2 rst % r0 ( 3 ) = 0.0d0 end select end function ! ------------------------------------------------------------------------------ pure function line_from_many_points ( pts ) result ( rst ) !! Constructs the line that best fits the supplied set of points in a !! least-squares sense. real ( real64 ), intent ( in ), dimension (:,:) :: pts !! An N-by-3 matrix where N is at least 2, but typically much !! larger. type ( line ) :: rst !! The resulting line. ! Local Variables character :: jobu , jobvt integer ( int32 ) :: i , m , n , mn , lwork , info real ( real64 ), allocatable , dimension (:,:) :: shifted , vt real ( real64 ), allocatable , dimension (:) :: s , work real ( real64 ) :: temp ( 1 ), dummy ( 1 ) ! Initialization jobu = 'N' jobvt = 'S' m = size ( pts , 1 ) n = size ( pts , 2 ) mn = min ( m , n ) ! Input Checking if ( m < 2 . or . n /= 3 ) then rst % r0 = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) rst % v = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) return end if ! Workspace Sizing - only compute V**T call DGESVD ( jobu , jobvt , m , n , dummy , m , dummy , dummy , m , dummy , mn , & temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork ), vt ( mn , n ), shifted ( m , n ), s ( mn )) ! Process if ( m == 2 ) then rst = line_from_2pts ( pts ( 1 ,:), pts ( 2 ,:)) else rst % r0 = [ mean ( pts (:, 1 )), mean ( pts (:, 2 )), mean ( pts (:, 3 ))] do i = 1 , m shifted ( i ,:) = pts ( i ,:) - rst % r0 end do call DGESVD ( jobu , jobvt , m , n , shifted , m , s , dummy , m , vt , mn , & work , lwork , info ) if ( info /= 0 ) then rst % r0 = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) rst % v = ieee_value ( 0.0d0 , IEEE_QUIET_NAN ) return end if rst % v = vt ( 1 ,:) / norm2 ( vt ( 1 ,:)) end if end function ! ------------------------------------------------------------------------------ pure function line_from_point_and_vector ( pt , x , nx ) result ( rst ) !! Constructs a new line from a point (defines the point where t = 0) !! and a direction vector. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point at which t = 0 on the line. real ( real64 ), intent ( in ) :: x ( 3 ) !! The direction vector defining the orientation of the line. logical , intent ( in ), optional :: nx !! An optional parameter that defines if x should be normalized to !! a unit vector (true), or left as-is (false). The default is !! true such that x is normalized to a unit vector. type ( line ) :: rst !! The resulting line. ! Local Variables logical :: nrm ! Initialization nrm = . true . if ( present ( nx )) nrm = nx ! Process rst % r0 = pt if ( nrm ) then rst % v = x / norm2 ( x ) else rst % v = x end if end function ! ------------------------------------------------------------------------------ ! LINE MEMBER ROUTINES ! ------------------------------------------------------------------------------ pure function line_eval ( this , t ) result ( rst ) !! Evaluates the equation of the line at the specified parameter. class ( line ), intent ( in ) :: this !! The line. real ( real64 ), intent ( in ) :: t !! The parameter. real ( real64 ) :: rst ( 3 ) !! The location along the line defined by the parameter t. rst = this % r0 + t * this % v end function ! ------------------------------------------------------------------------------ ! LINE OPERATORS ! ------------------------------------------------------------------------------ pure elemental subroutine line_assign ( x , y ) !! Assigns a line to another. type ( line ), intent ( out ) :: x !! The resulting line. type ( line ), intent ( in ) :: y !! The source line x % r0 = y % r0 x % v = y % v end subroutine ! ****************************************************************************** ! GEOMETRY CALCULATIONS ! ------------------------------------------------------------------------------ pure function is_parallel_vectors ( x , y , tol ) result ( rst ) !! Tests to see if two vectors are parallel. real ( real64 ), intent ( in ), dimension (:) :: x !! The first vector. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The second vector. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing for parallelism. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the vectors are parallel; else, false. ! Local Variables real ( real64 ) :: t , cp ( 3 ) ! Initialization if ( present ( tol )) then t = tol else t = 1.0d1 * epsilon ( t ) end if ! Process cp = cross_product ( x , y ) rst = ( abs ( cp ( 1 )) <= t . and . abs ( cp ( 2 )) <= t . and . abs ( cp ( 3 )) <= t ) end function ! ------------------------------------------------------------------------------ pure function is_parallel_lines ( x , y , tol ) result ( rst ) !! Tests to see if two lines are parallel. class ( line ), intent ( in ) :: x !! The first line. class ( line ), intent ( in ) :: y !! The second line. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing for parallelism. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the lines are parallel; else, false. ! Process rst = is_parallel_vectors ( x % v , y % v , tol = tol ) end function ! ------------------------------------------------------------------------------ pure function is_parallel_planes ( x , y , tol ) result ( rst ) !! Tests to see if two planes are parallel. class ( plane ), intent ( in ) :: x !! The first plane. class ( plane ), intent ( in ) :: y !! The second plane. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing for parallelism. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the planes are parallel; else, false. ! Process rst = is_parallel_vectors ( plane_normal ( x ), plane_normal ( y ), tol = tol ) end function ! ------------------------------------------------------------------------------ pure function is_point_on_plane ( pt , pln , tol ) result ( rst ) !! Tests to see if a point lies on a plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the point lies on the plane; else, false. ! Local Variables real ( real64 ) :: t , s ! Initialization if ( present ( tol )) then t = tol else t = 1.0d1 * epsilon ( t ) end if ! Process s = pln % a * pt ( 1 ) + pln % b * pt ( 2 ) + pln % c * pt ( 3 ) + pln % d rst = abs ( s ) <= t end function ! ------------------------------------------------------------------------------ pure function is_point_on_line ( pt , ln , tol ) result ( rst ) !! Tests to see if a point lies on a line. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( line ), intent ( in ) :: ln !! The line. real ( real64 ), intent ( in ), optional :: tol !! The tolerance to use when testing. The default !! tolerance is 10x machine epsilon. logical :: rst !! Returns true if the point lies on the line; else, false. ! Local Variables real ( real64 ) :: t , d ! Initialization if ( present ( tol )) then t = tol else t = 1.0d1 * epsilon ( t ) end if ! Process d = point_to_line_distance ( pt , ln ) rst = d <= t ! d is always positive end function ! ------------------------------------------------------------------------------ pure function nearest_point_on_line ( pt , ln ) result ( rst ) !! Gets the line parameter for the point on the line nearest the !! specified point. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( line ), intent ( in ) :: ln !! The line. real ( real64 ) :: rst !! The line parameteric variable t defining the location of !! the point nearest along the line. ! References: ! https://mathworld.wolfram.com/Point-LineDistance3-Dimensional.html rst = - dot_product ( ln % r0 - pt , ln % v ) / ( norm2 ( ln % v ) ** 2 ) end function ! ------------------------------------------------------------------------------ pure function point_to_line_distance ( pt , ln ) result ( rst ) !! Computes the shortest distance between a point and a line. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( line ), intent ( in ) :: ln !! The line. real ( real64 ) :: rst !! The shortest distance between the point and line. ! Local Variables real ( real64 ) :: t , d ( 3 ) ! Process t = nearest_point_on_line ( pt , ln ) d = pt - ln % evaluate ( t ) rst = norm2 ( d ) end function ! ------------------------------------------------------------------------------ pure function point_to_plane_distance ( pt , pln ) result ( rst ) !! Computes the shortest distance between a point and a plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ) :: rst !! The shortest distance between the point and plane. ! Process rst = abs ( pln % a * pt ( 1 ) + pln % b * pt ( 2 ) + pln % c * pt ( 3 ) + pln % d ) / & norm2 ([ pln % a , pln % b , pln % c ]) end function ! ------------------------------------------------------------------------------ pure function vector_plane_projection ( x , pln ) result ( rst ) !! Projects a vector onto a plane. real ( real64 ), intent ( in ) :: x ( 3 ) !! The vector to project. class ( plane ), intent ( in ) :: pln !! The plane onto which to project the vector. real ( real64 ) :: rst ( 3 ) !! The projected vector. ! Local Variables real ( real64 ) :: nrm ( 3 ), y ( 3 ) ! Process nrm = plane_normal ( pln ) y = vector_projection ( x , nrm ) rst = x - y end function ! ------------------------------------------------------------------------------ pure function point_plane_projection ( pt , pln ) result ( rst ) !! Projects a point onto a plane. real ( real64 ), intent ( in ) :: pt ( 3 ) !! The point. class ( plane ), intent ( in ) :: pln !! The plane onto which to project the point. real ( real64 ) :: rst ( 3 ) !! The projected point. ! Local Variables real ( real64 ) :: t , n ( 3 ) ! Process n = [ pln % a , pln % b , pln % c ] t = - ( pln % c * pt ( 3 ) + pln % b * pt ( 2 ) + pln % a * pt ( 1 ) + pln % d ) / & ( norm2 ( n ) ** 2 ) rst = pt + t * n end function ! ****************************************************************************** ! PLUCKER_LINE ! ------------------------------------------------------------------------------ pure function pl_from_2pts ( pt1 , pt2 ) result ( rst ) !! Constructs a new plucker_line from two points. real ( real64 ), intent ( in ) :: pt1 ( 3 ) !! The first point. real ( real64 ), intent ( in ) :: pt2 ( 3 ) !! The second point. type ( plucker_line ) :: rst !! The resulting line. rst % v ( 1 : 3 ) = pt2 - pt1 rst % v ( 1 : 3 ) = rst % v ( 1 : 3 ) / norm2 ( rst % v ( 1 : 3 )) rst % v ( 4 : 6 ) = cross_product ( pt1 , rst % v ( 1 : 3 )) end function ! ------------------------------------------------------------------------------ pure function pl_from_line ( ln ) result ( rst ) !! Constructs a new plucker_line from a line object. class ( line ), intent ( in ) :: ln !! The line. type ( plucker_line ) :: rst !! The equivalent plucker_line. rst = pl_from_2pts ( ln % evaluate ( 0.0d0 ), ln % evaluate ( 1.0d0 )) end function ! ------------------------------------------------------------------------------ pure function pl_from_2_planes ( p1 , p2 ) result ( rst ) !! Constructs a new plucker_line from the intersection of two planes. class ( plane ), intent ( in ) :: p1 !! The first plane. class ( plane ), intent ( in ) :: p2 !! The second plane. type ( plucker_line ) :: rst !! The resulting line. NaN's are returned in the event that the !! two planes are parallel. rst = pl_from_line ( line ( p1 , p2 )) end function ! ------------------------------------------------------------------------------ pure function pl_from_array ( x , nrm ) result ( rst ) !! Constructs a new plucker_line from the supplied array. real ( real64 ), intent ( in ) :: x ( 6 ) !! A 6-element array containing the Plücker coordinates. logical , intent ( in ), optional :: nrm !! An optional input that specifies if the first three coordinates !! (the unit vector) should be normalized (true), or left as-is !! (false). The default is true such that the vector is normalized. type ( plucker_line ) :: rst !! The resulting line. logical :: n n = . true . if ( present ( nrm )) n = nrm if ( n ) then rst % v ( 1 : 3 ) = x ( 1 : 3 ) / norm2 ( x ( 1 : 3 )) rst % v ( 4 : 6 ) = x ( 4 : 6 ) else rst % v = x end if end function ! ------------------------------------------------------------------------------ pure function pl_matmul ( x , y ) result ( rst ) !! Overloads the matmul routine to allow for multiplication of the !! Plücker line coordinate vector with a matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x !! The N-by-6 matrix. type ( plucker_line ), intent ( in ) :: y !! The plucker_line object. real ( real64 ), allocatable , dimension (:) :: rst !! The resulting N-element array. rst = matmul ( x , y % v ) end function ! ------------------------------------------------------------------------------ ! PLUCKER_LINE OPERATORS ! ------------------------------------------------------------------------------ pure elemental subroutine pl_assign ( x , y ) !! Assigns a plucker_line to another. type ( plucker_line ), intent ( out ) :: x !! The resulting plucker_line. type ( plucker_line ), intent ( in ) :: y !! The source plucker_line. x % v = y % v end subroutine ! ------------------------------------------------------------------------------ pure elemental subroutine pl_assign_line ( x , y ) !! Assigns a line to a plucker_line. type ( plucker_line ), intent ( out ) :: x !! The resulting plucker_line. type ( line ), intent ( in ) :: y !! The source line. x = plucker_line ( y ) end subroutine ! ------------------------------------------------------------------------------ ! PLUCKER_LINE MEMBERS ! ------------------------------------------------------------------------------ pure function pl_u ( this ) result ( rst ) !! The unit vector representing the orientation of the line. class ( plucker_line ), intent ( in ) :: this !! The plucker_line object. real ( real64 ) :: rst ( 3 ) !! The unit vector. rst = this % v ( 1 : 3 ) end function ! ------------------------------------------------------------------------------ pure function pl_m ( this ) result ( rst ) !! The line moment vector. class ( plucker_line ), intent ( in ) :: this !! The plucker_line object. real ( real64 ) :: rst ( 3 ) !! The moment vector. rst = this % v ( 4 : 6 ) end function ! ------------------------------------------------------------------------------ pure function pl_to_array ( this ) result ( rst ) !! Returns the plucker_line as a 6-element array of the form [u, m]. class ( plucker_line ), intent ( in ) :: this !! The plucker_line object. real ( real64 ) :: rst ( 6 ) !! The resulting array. rst = this % v end function ! ****************************************************************************** ! ADDITIONAL GEOMETRIC CALCULATIONS (ADDED 3/5/2026, JAC) ! ------------------------------------------------------------------------------ pure function line_common_normal ( ln1 , ln2 ) result ( rst ) !! Returns the common normal line between two lines pointing from ln1 to !! ln2. In the event that the two lines are parallel within the !! specified tolerance, there exist an infinite number of common !! normals; therefore, a line will be chosen that runs from ln1 to ln2 !! with the point at t = 0 coincident with the point at t = 0 on ln1. class ( line ), intent ( in ) :: ln1 !! The first line. class ( line ), intent ( in ) :: ln2 !! The second line. type ( line ) :: rst !! The common normal line. The distance along this line between !! t = 0 and t = 1 defines the length of the common normal !! connecting ln1 to ln2. In the event that ln1 and ln2 intersect, !! the length of this line is zero. ! Local Variables logical :: coincident integer ( int32 ) :: lwork , info , ipvt ( 2 ), rnk real ( real64 ) :: s , t , xi ( 3 ), p1 ( 3 ), p2 ( 3 ), A ( 3 , 2 ), x ( 3 ), temp ( 1 ), rc real ( real64 ), allocatable , dimension (:) :: work ! Initialization t = 1.0d1 * epsilon ( t ) ipvt = 0 rc = epsilon ( rc ) ! Compute the cross products of the direction vectors. xi = cross_product ( ln2 % v , ln1 % v ) ! Locate the point on ln2 that is an intersection between the common ! normal and ln2. This can be accomplished by noting that: ! ! ln1%r0 + t * xi = ln2%ro + s * ln2%v ! ! We need to solve for s and t p1 = ln1 % evaluate ( 0.0d0 ) ! Compute the coefficient matrix A (:, 1 ) = xi A (:, 2 ) = - ln2 % v ! Compute the right-hand-side x = ln2 % r0 - ln1 % r0 ! Set up the least-squares solver. We use DGELSY as we have 3 equations ! but only 2 unknowns. call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Solve call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , work , lwork , info ) s = x ( 2 ) ! we can use either t or s. s is associated with ln2 p2 = ln2 % evaluate ( s ) rst = line ( p1 , p2 ) ! Ensure that rst is of finite length if ( norm2 ( rst % evaluate ( 1.0d0 ) - rst % evaluate ( 0.0d0 )) <= t ) then coincident = . true . else if ( ieee_is_nan ( rst % v ( 1 )) . or . ieee_is_nan ( rst % v ( 2 )) . or . & ieee_is_nan ( rst % v ( 3 ))) & then coincident = . true . else coincident = . false . end if if ( coincident ) then ! If the lines are coincident we offset them by the specified ! zero tolerance along the computed common normal axis rst % r0 = p1 rst % v = 0.0d0 end if end function ! ------------------------------------------------------------------------------ pure subroutine do_lines_intersect ( ln1 , ln2 , intersect , t1 , t2 , tol ) !! Tests to see if two lines intersect. class ( line ), intent ( in ) :: ln1 !! The first line. class ( line ), intent ( in ) :: ln2 !! The second line. logical , intent ( out ) :: intersect !! True if the two lines intersect within the specified tolerance; !! else, false if they do not intersect. real ( real64 ), intent ( out ), optional :: t1 !! The parametric value associate with ln1 defining the intersection !! point. real ( real64 ), intent ( out ), optional :: t2 !! The parametric value associate with ln2 defining the intersection !! point. real ( real64 ), intent ( in ), optional :: tol !! The intersection tolerance. If not supplied, the default value !! is 10x machine epsilon. ! Local Variables integer ( int32 ) :: lwork , info , rnk , ipvt ( 2 ) real ( real64 ) :: tolerance , A ( 3 , 2 ), x ( 3 ), s , t , temp ( 1 ), p1 ( 3 ), p2 ( 3 ), & dp ( 3 ), nan , rc real ( real64 ), allocatable , dimension (:) :: work ! Initialization if ( present ( tol )) then tolerance = tol else tolerance = 1.0d1 * epsilon ( tolerance ) end if nan = ieee_value ( nan , IEEE_QUIET_NAN ) A (:, 1 ) = ln2 % v A (:, 2 ) = - ln1 % v x = ln1 % r0 - ln2 % r0 ipvt = 0 rc = epsilon ( rc ) ! Set up the least-squares solver call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , temp , - 1 , info ) lwork = int ( temp ( 1 ), int32 ) allocate ( work ( lwork )) ! Solve A {s;t} = X call DGELSY ( 3 , 2 , 1 , A , 3 , x , 3 , ipvt , rc , rnk , work , lwork , info ) if ( info /= 0 ) then intersect = . false . s = nan t = nan else s = x ( 1 ) t = x ( 2 ) p1 = ln1 % evaluate ( t ) p2 = ln2 % evaluate ( s ) dp = abs ( p2 - p1 ) if ( dp ( 1 ) > tolerance . or . dp ( 2 ) > tolerance . or . & dp ( 3 ) > tolerance ) & then ! No intersection intersect = . false . s = nan t = nan else ! We've got an intersection point intersect = . true . end if end if if ( present ( t1 )) t1 = t if ( present ( t2 )) t2 = s end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_geometry.f90.html"},{"title":"dynamics_helper.f90 – DYNAMICS","text":"Contents Modules dynamics_helper Source Code dynamics_helper.f90 Source Code module dynamics_helper use iso_fortran_env implicit none private public :: cross_product public :: to_skew_symmetric public :: vector_angle public :: scalar_projection public :: vector_projection contains ! ------------------------------------------------------------------------------ pure function cross_product ( x , y ) result ( rst ) !! Computes the cross-product of a vector. real ( real64 ), intent ( in ) :: x ( 3 ) !! The left-hand-side argument. real ( real64 ), intent ( in ) :: y ( 3 ) !! The right-hand-side argument real ( real64 ) :: rst ( 3 ) !! The resulting vector. rst ( 1 ) = x ( 2 ) * y ( 3 ) - x ( 3 ) * y ( 2 ) rst ( 2 ) = x ( 3 ) * y ( 1 ) - x ( 1 ) * y ( 3 ) rst ( 3 ) = x ( 1 ) * y ( 2 ) - x ( 2 ) * y ( 1 ) end function ! ------------------------------------------------------------------------------ pure function to_skew_symmetric ( x ) result ( rst ) !! Converts a 3-element vector to a 3-by-3 skew-symmetric matrix. A !! skew-symmetric matrix is defined as follows. !! !! \\tilde{x} = \\left[ \\begin{matrix} 0 & -x_{3} & x_{2} \\\\ !! x_{3} & 0 & -x_{1} \\\\ -x_{2} & x_{1} & 0 \\end{matrix} \\right] real ( real64 ), intent ( in ) :: x ( 3 ) !! The vector. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting skew-symmetric matrix. ! Process rst = reshape ([ & 0.0d0 , x ( 3 ), - x ( 2 ), & - x ( 3 ), 0.0d0 , x ( 1 ), & x ( 2 ), - x ( 1 ), 0.0d0 & ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function vector_angle ( x , y ) result ( rst ) !! Computes the angle between two vectors. real ( real64 ), intent ( in ), dimension (:) :: x !! The first vector. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The second vector. real ( real64 ) :: rst !! The angle, in radians. ! Local Variables real ( real64 ) :: xmag , ymag , ct ! Process xmag = norm2 ( x ) ymag = norm2 ( y ) ct = dot_product ( x , y ) / ( xmag * ymag ) rst = acos ( ct ) end function ! ------------------------------------------------------------------------------ pure function scalar_projection ( x , y ) result ( rst ) !! Computes the projection of vector x onto vector y. The scalar projection !! is defined such that s = \\frac{\\vec{x} \\cdot \\vec{y}}{||\\vec{y}||} . real ( real64 ), intent ( in ), dimension (:) :: x !! The vector to project. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The vector onto which x should be projected. real ( real64 ) :: rst !! The scalar projection of x onto y. ! Process rst = dot_product ( x , y ) / norm2 ( y ) end function ! ------------------------------------------------------------------------------ pure function vector_projection ( x , y ) result ( rst ) !! Computes the vector pojection of vector x onto vector y. The vector !! projection is defined such that proj_{y} \\vec{x} = !! \\frac{\\vec{x} \\cdot \\vec{y}}{||\\vec{y}||^{2}} \\vec{y} real ( real64 ), intent ( in ), dimension (:) :: x !! The vector to project. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The vector onto which x should be projected. real ( real64 ) :: rst ( 3 ) !! The vector projection of x onto y. ! Process rst = y * dot_product ( x , y ) / dot_product ( y , y ) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_helper.f90.html"},{"title":"dynamics_kinematics.f90 – DYNAMICS","text":"Contents Modules dynamics_kinematics Source Code dynamics_kinematics.f90 Source Code module dynamics_kinematics use iso_fortran_env use nonlin use ferror use dynamics_error_handling use dynamics_helper use dynamics_geometry use dynamics_quaternions implicit none private public :: identity_4 public :: dh_rotate_x public :: dh_rotate_z public :: dh_translate_x public :: dh_translate_z public :: dh_matrix public :: dh_forward_kinematics public :: solve_inverse_kinematics public :: vecfcn public :: jacobianfcn public :: least_squares_solver public :: iteration_behavior public :: vecfcn_helper public :: jacobian_generating_vector public :: dh_jacobian public :: REVOLUTE_JOINT public :: PRISMATIC_JOINT public :: coordinate_system public :: dh_parameter_set public :: dh_table interface dh_forward_kinematics module procedure :: dh_forward_kinematics_2 module procedure :: dh_forward_kinematics_3 module procedure :: dh_forward_kinematics_4 module procedure :: dh_forward_kinematics_5 module procedure :: dh_forward_kinematics_6 module procedure :: dh_forward_kinematics_7 module procedure :: dh_forward_kinematics_8 module procedure :: dh_forward_kinematics_array module procedure :: dh_forward_kinematics_dh_params module procedure :: dh_forward_kinematics_dh_table end interface interface dh_jacobian module procedure :: dh_build_jacobian end interface integer ( int32 ), parameter :: REVOLUTE_JOINT = 0 !! Defines a revolute joint. integer ( int32 ), parameter :: PRISMATIC_JOINT = 1 !! Defines a prismatic joint. type coordinate_system !! Defines a 3D Cartesian coordinate system. real ( real64 ) :: origin ( 3 ) !! The location of the origin of the coordinate system in the parent !! coordinate system. real ( real64 ) :: i ( 3 ) !! The unit vector along the coordinate system's x-axis. real ( real64 ) :: j ( 3 ) !! The unit vector along the coordinate system's y-axis. real ( real64 ) :: k ( 3 ) !! The unit vector along the coordinate system's z-axis. end type interface coordinate_system module procedure :: define_link_csys module procedure :: define_csys end interface type dh_parameter_set !! Describes a set of Denavit-Hartenberg parameters for a single joint. real ( real64 ) :: link_length !! The link length is the distance between the proximal and distal !! joint axes as measured along the link's x-axis. real ( real64 ) :: link_twist !! The link twist is the required rotation of the proximal joint !! axis about the link's x-axis to become parallel to the distal !! joint's axis. real ( real64 ) :: link_offset !! The link offset is the distance between the previous link's !! x-axis and the current link's x-axis as measured along the !! axis of the proximal joint. real ( real64 ) :: joint_angle !! The joint angle is the required rotation of the previous link's !! x-axis about the proximal joint's axis to become parallel to the !! current link's x-axis. end type interface dh_parameter_set module procedure :: dps_init end interface type dh_table !! Describes a Denavit-Hartenberg table. type ( dh_parameter_set ), allocatable , dimension (:) :: parameters !! A collection of DH parameters for each joint in the linkage. end type interface dh_table module procedure :: dh_table_init end interface ! ------------------------------------------------------------------------------ ! PRIVATE - INVERSE KINEMATICS type inverse_kinematics_container !! A container for passing kinematics information around the inverse !! solver. procedure ( vecfcn ), pointer , nopass :: kinematics_equations !! A pointer to the kinematics equations. real ( real64 ), allocatable , dimension (:) :: kinematic_constraints !! A constraints array. class ( * ), pointer :: user_args => null () !! User supplied arguments to the kinematics_equations model. end type contains ! ------------------------------------------------------------------------------ pure function identity_4 () result ( rst ) !! Computes a 4-by-4 identity matrix. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting identity matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 ! Process rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = one rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_rotate_x ( alpha ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local x-axis rotation. real ( real64 ), intent ( in ) :: alpha !! The rotation angle, in radians. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 real ( real64 ) :: cx , sx ! Process cx = cos ( alpha ) sx = sin ( alpha ) rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = cx rst ( 3 , 2 ) = sx rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = - sx rst ( 3 , 3 ) = cx rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_rotate_z ( theta ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local z-axis rotation. real ( real64 ), intent ( in ) :: theta !! The rotation angle, in radians. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 real ( real64 ) :: cx , sx ! Process cx = cos ( theta ) sx = sin ( theta ) rst ( 1 , 1 ) = cx rst ( 2 , 1 ) = sx rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = - sx rst ( 2 , 2 ) = cx rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_translate_x ( a ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local x-axis !! translation. real ( real64 ), intent ( in ) :: a !! The translation. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 ! Process rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = one rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = a rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = zero rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_translate_z ( d ) result ( rst ) !! Computes the Denavit-Hartenberg matrix for a local z-axis !! translation. real ( real64 ), intent ( in ) :: d !! The translation. real ( real64 ) :: rst ( 4 , 4 ) !! The matrix. ! Local Variables & Parameters real ( real64 ), parameter :: zero = 0.0d0 real ( real64 ), parameter :: one = 1.0d0 ! Process rst ( 1 , 1 ) = one rst ( 2 , 1 ) = zero rst ( 3 , 1 ) = zero rst ( 4 , 1 ) = zero rst ( 1 , 2 ) = zero rst ( 2 , 2 ) = one rst ( 3 , 2 ) = zero rst ( 4 , 2 ) = zero rst ( 1 , 3 ) = zero rst ( 2 , 3 ) = zero rst ( 3 , 3 ) = one rst ( 4 , 3 ) = zero rst ( 1 , 4 ) = zero rst ( 2 , 4 ) = zero rst ( 3 , 4 ) = d rst ( 4 , 4 ) = one end function ! ------------------------------------------------------------------------------ pure function dh_matrix ( alpha , a , theta , d ) result ( rst ) !! Computes the Denavit-Hartenberg transformation matrix for the !! specified DH parameters. real ( real64 ), intent ( in ) :: alpha !! The link twist angle, in radians. This angle is the required !! rotation of the z(i-1) axis about the link's x-axis to become !! parallel with the link's z-axis. real ( real64 ), intent ( in ) :: a !! The link length as measured along the link's x-axis. real ( real64 ), intent ( in ) :: theta !! The joint angle, in radians. This angle is the required rotation !! of the z(i-1) axis about the z(i-1) axis to become parallel with !! the link's x-axis. real ( real64 ), intent ( in ) :: d !! The joint offset distance measured as the distance between the !! x(i-1) axis and the link's x-axis along the z(i-1) axis. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables real ( real64 ), dimension ( 4 , 4 ) :: Rx , Dx , Rz , Dz , DxRx , RzDxRx ! Compute the matrices Rx = dh_rotate_x ( alpha ) Dx = dh_translate_x ( a ) Rz = dh_rotate_z ( theta ) Dz = dh_translate_z ( d ) ! Perform the multiplication DxRx = matmul ( Dx , Rx ) RzDxRx = matmul ( Rz , DxRx ) rst = matmul ( Dz , RzDxRx ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_2 ( T1 , T2 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Process rst = matmul ( T1 , T2 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_3 ( T1 , T2 , T3 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_2 ( T1 , T2 ) rst = matmul ( T0 , T3 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_4 ( T1 , T2 , T3 , T4 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_3 ( T1 , T2 , T3 ) rst = matmul ( T0 , T4 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_5 ( T1 , T2 , T3 , T4 , T5 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_4 ( T1 , T2 , T3 , T4 ) rst = matmul ( T0 , T5 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_6 ( T1 , T2 , T3 , T4 , T5 , T6 ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ), intent ( in ) :: T6 ( 4 , 4 ) !! The transformation matrix for the sixth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_5 ( T1 , T2 , T3 , T4 , T5 ) rst = matmul ( T0 , T6 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_7 ( T1 , T2 , T3 , T4 , T5 , T6 , T7 ) & result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ), intent ( in ) :: T6 ( 4 , 4 ) !! The transformation matrix for the sixth link in the linkage. real ( real64 ), intent ( in ) :: T7 ( 4 , 4 ) !! The transformation matrix for the seventh link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_6 ( T1 , T2 , T3 , T4 , T5 , T6 ) rst = matmul ( T0 , T7 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_8 ( T1 , T2 , T3 , T4 , T5 , T6 , T7 , T8 ) & result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. real ( real64 ), intent ( in ) :: T1 ( 4 , 4 ) !! The transformation matrix for the first link nearest ground in !! the linkage. real ( real64 ), intent ( in ) :: T2 ( 4 , 4 ) !! The transformation matrix for the second link in the linkage. real ( real64 ), intent ( in ) :: T3 ( 4 , 4 ) !! The transformation matrix for the third link in the linkage. real ( real64 ), intent ( in ) :: T4 ( 4 , 4 ) !! The transformation matrix for the fourth link in the linkage. real ( real64 ), intent ( in ) :: T5 ( 4 , 4 ) !! The transformation matrix for the fifth link in the linkage. real ( real64 ), intent ( in ) :: T6 ( 4 , 4 ) !! The transformation matrix for the sixth link in the linkage. real ( real64 ), intent ( in ) :: T7 ( 4 , 4 ) !! The transformation matrix for the seventh link in the linkage. real ( real64 ), intent ( in ) :: T8 ( 4 , 4 ) !! The transformation matrix for the eigth link in the linkage. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting transformation matrix. ! Local Variables real ( real64 ) :: T0 ( 4 , 4 ) ! Process T0 = dh_forward_kinematics_7 ( T1 , T2 , T3 , T4 , T5 , T6 , T7 ) rst = matmul ( T0 , T8 ) end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_array ( alpha , a , theta , d ) result ( rst ) !! Assembles all of the individual link transformation matrices into a !! single transformation matrix locating the end-effector in the parent !! coordinate system for the overall mechanism. The first entry must !! be from the first link nearest ground. real ( real64 ), intent ( in ), dimension (:) :: alpha !! The link twist angles, in radians. This angle is the required !! rotation of the z(i-1) axis about the link's x-axis to become !! parallel with the link's z-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: a !! The link lengths as measured along the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: theta !! The joint angles, in radians. This angle is the required rotation !! of the z(i-1) axis about the z(i-1) axis to become parallel with !! the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: d !! The joint offsets distance measured as the distance between the !! x(i-1) axis and the link's x-axis along the z(i-1) axis. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: Ti ( 4 , 4 ) ! Initialization n = size ( alpha ) rst = identity_4 () ! Process do i = 1 , n Ti = dh_matrix ( alpha ( i ), a ( i ), theta ( i ), d ( i )) rst = matmul ( rst , Ti ) end do end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_dh_params ( x ) result ( rst ) !! Assembles all of the individual link transformation matrices into !! a single transformation matrix locating the end-effector in the !! parent coordinate system for the overall mechanism. class ( dh_parameter_set ), intent ( in ), dimension (:) :: x !! The list of DH parameters. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: Ti ( 4 , 4 ) ! Initialization n = size ( x ) rst = identity_4 () ! Process do i = 1 , n Ti = dh_matrix ( x ( i )% link_twist , x ( i )% link_length , & x ( i )% joint_angle , x ( i )% link_offset ) rst = matmul ( rst , Ti ) end do end function ! ------------------------------------------------------------------------------ pure function dh_forward_kinematics_dh_table ( x ) result ( rst ) !! Assembles all of the individual link transformation matrices into !! a single transformation matrix locating the end-effector in the !! parent coordinate system for the overall mechanism. class ( dh_table ), intent ( in ) :: x !! The DH table. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Process rst = dh_forward_kinematics ( x % parameters ) end function ! ------------------------------------------------------------------------------ function solve_inverse_kinematics ( mdl , qo , constraints , df , & slvr , ib , jfcn , qmax , qmin , args , err ) result ( rst ) !! Solves the inverse kinematics problem for a linkage. An iterative !! solution procedure is utilized. procedure ( vecfcn ), intent ( in ), pointer :: mdl !! A routine used to compute the forward kinematics for the linkage !! given the current joint variable estimates. real ( real64 ), intent ( in ), dimension (:) :: qo !! An M-element array containing an initial estimate of the M joint !! variables. real ( real64 ), intent ( in ), target , dimension (:) :: constraints !! An N-element array containing the target values (constraints) for !! each of the N kinematic equations in the model. N must be at !! least equal to M (the number of joint variables). real ( real64 ), intent ( out ), optional , target , dimension (:) :: df !! An optional N-element array that, if supplied, can be used to !! retrieve the residuals of each of the N kinematic equations. class ( constrained_equation_solver ), intent ( inout ), optional , target :: slvr !! An optional solver that can be used in place of the default !! Levenberg-Marquardt solver. type ( iteration_behavior ), intent ( out ), optional :: ib !! An optional output that can be used to gather information on the !! solver. procedure ( jacobianfcn ), intent ( in ), pointer , optional :: jfcn !! A routine that can be used to provide the Jacobian matrix for !! the linkage. real ( real64 ), intent ( in ), dimension ( size ( qo )), optional :: qmax !! An optional set of upper limits on each of the joint variables. !! If not provided, the default is the output of the 'huge' !! intrinsic function. real ( real64 ), intent ( in ), dimension ( size ( qo )), optional :: qmin !! An optional set of lower limits on each of the joint variables. !! If not provided, the default is the negative of the output of !! the 'huge' intrinsic function. class ( * ), intent ( inout ), optional , target :: args !! An optional argument that can be used to communicate with mdl. class ( errors ), intent ( inout ), optional , target :: err !! An errors-based object that if provided can be used to retrieve !! information relating to any errors encountered during execution. real ( real64 ), allocatable , dimension (:) :: rst !! An M-element array containing the computed joint variables. ! Local Variables integer ( int32 ) :: nvar , neqn , flag real ( real64 ), pointer , dimension (:) :: resid real ( real64 ), allocatable , target , dimension (:) :: dresid type ( vecfcn_helper ) :: helper class ( constrained_equation_solver ), pointer :: solver type ( constrained_least_squares_solver ), target :: default_solver procedure ( vecfcn ), pointer :: fcn class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( inverse_kinematics_container ) :: obj ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if nvar = size ( qo ) neqn = size ( constraints ) if ( present ( slvr )) then solver => slvr else solver => default_solver end if obj % kinematics_equations => mdl obj % kinematic_constraints = constraints if ( present ( args )) obj % user_args => args ! Input Check if ( neqn < nvar ) then call report_constraint_count_error ( \"solve_inverse_kinematics\" , & nvar , neqn , errmgr ) return end if if ( present ( df )) then if ( size ( df ) /= neqn ) then call report_array_size_error ( \"solve_inverse_kinematics\" , \"df\" , & neqn , size ( df ), errmgr ) return end if end if if ( present ( qmax )) call solver % set_upper_limits ( qmax ) if ( present ( qmin )) call solver % set_lower_limits ( qmin ) ! Set up the solver fcn => inverse_kinematics_solver_fcn call helper % set_fcn ( fcn , neqn , nvar ) if ( present ( jfcn )) then call helper % set_jacobian ( jfcn ) end if ! Local Memory Allocations allocate ( rst ( nvar ), source = qo , stat = flag ) if ( present ( df )) then resid => df else if ( flag == 0 ) allocate ( dresid ( neqn ), stat = flag ) if ( flag == 0 ) resid => dresid end if if ( flag /= 0 ) then call report_memory_error ( \"solve_inverse_kinematics\" , flag , errmgr ) return end if ! Solve the problem call solver % solve ( helper , rst , resid , ib = ib , args = obj , err = errmgr ) end function ! ---------- subroutine inverse_kinematics_solver_fcn ( x , f , args ) ! Routine called by the inverse kinematics solver real ( real64 ), intent ( in ), dimension (:) :: x real ( real64 ), intent ( out ), dimension (:) :: f class ( * ), intent ( inout ), optional :: args ! Process select type ( args ) class is ( inverse_kinematics_container ) ! Compute the kinematics equations if ( associated ( args % user_args )) then call args % kinematics_equations ( x , f , args % user_args ) else call args % kinematics_equations ( x , f ) end if ! Compare with the constraints f = f - args % kinematic_constraints end select end subroutine ! ****************************************************************************** ! V1.0.8 ADDITIONS ! JAN. 29, 2025 ! ------------------------------------------------------------------------------ pure function jacobian_generating_vector ( d , k , R , jtype ) result ( rst ) !! Computes a single Jacobian generating vector given the position vector !! of the link origin, \\vec{d}, and the joint axis unit vector, !! \\vec{k}. !! !! For a revolute joint: !! !! \\vec{c_{i}} = \\left( \\begin{matrix} !! R \\left( \\hat{k} \\times \\vec{d_{i-1}} \\right) \\\\ !! \\vec{k_{i-1}} \\end{matrix} \\right) !! !! For a prismatic joint: !! !! \\vec{c_{i}} = \\left( \\begin{matrix} \\vec{k_{i-1}} \\\\ 0 \\end{matrix} !! \\right) !! !! The Jacobian matrix is then constructed from the Jacobian generating !! vectors as follows. !! !! J = \\left[ \\begin{matrix} \\vec{c_1} & \\vec{c_2} & ... & \\vec{c_n} !! \\end{matrix} \\right] real ( real64 ), intent ( in ) :: d ( 3 ) !! The position vector of the end-effector, \\vec{d}, relative to the !! link coordinate frame given in the base coordinate frame. An easy !! way to compute this vector is to extract the first 3 elements of the !! 4th column of the transformation matrix: T_{i} T_{i+1} ... T_{n}. real ( real64 ), intent ( in ) :: k ( 3 ) !! The unit vector defining the joint axis, \\vec{k}, given in the !! base coordinate frame. This vector can be computed most easily by !! using the transformation matrix: T = T_1 T_2 ... T_{i-1} and !! then computing \\vec{k_{i-1}} = T \\hat{k}. real ( real64 ), intent ( in ) :: R ( 3 , 3 ) !! The rotation matrix defining the orientation of the link coordinate !! frame relative to the base coordinate frame. integer ( int32 ), intent ( in ) :: jtype !! The joint type. Must be either REVOLUTE_JOINT or PRISMATIC_JOINT. !! If incorrectly specified, the code defaults to a REVOLUTE_JOINT type. real ( real64 ) :: rst ( 6 ) !! The resulting 6-element Jacobian generating vector. ! Parameter real ( real64 ), parameter :: zi ( 3 ) = [ 0.0d0 , 0.0d0 , 1.0d0 ] ! Local Variables real ( real64 ) :: kmag , kcrossd , kunit ( 3 ) ! Ensure k is a unit vector kmag = norm2 ( k ) kunit = k / kmag ! Process if ( jtype == PRISMATIC_JOINT ) then rst ( 1 : 3 ) = kunit rst ( 4 : 6 ) = 0.0d0 else ! Compute the cross-product term rst ( 1 : 3 ) = matmul ( R , cross_product ( zi , d )) ! Fill in the remaining components rst ( 4 : 6 ) = kunit end if end function ! ------------------------------------------------------------------------------ function dh_build_jacobian ( alpha , a , theta , d , jtypes ) result ( rst ) !! Builds the Jacobian matrix for a linkage given the Denavit-Hartenberg !! parameters. The first entry in each array must be from the first link !! nearest ground. The Jacobian matrix relates the joint velocities !! \\dot{\\vec{q}} to the end-effector velocity \\dot{\\vec{X}} by !! \\dot{\\vec{X}} = J \\dot{\\vec{q}}. real ( real64 ), intent ( in ), dimension (:) :: alpha !! The link twist angles, in radians. This angle is the required !! rotation of the z(i-1) axis about the link's x-axis to become !! parallel with the link's z-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: a !! The link lengths as measured along the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: theta !! The joint angles, in radians. This angle is the required rotation !! of the z(i-1) axis about the z(i-1) axis to become parallel with !! the link's x-axis. real ( real64 ), intent ( in ), dimension ( size ( alpha )) :: d !! The joint offsets distance measured as the distance between the !! x(i-1) axis and the link's x-axis along the z(i-1) axis. integer ( int32 ), intent ( in ), dimension ( size ( alpha )) :: jtypes !! The types of each joint. Must be either REVOLUTE_JOINT or !! PRISMATIC_JOINT. The code defaults to REVOLUTE_JOINT. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 6-by-N Jacobian matrix where N is the number of joint !! variables (i.e. the length of the input arrays). ! Parameters real ( real64 ), parameter :: zi_1 ( 4 ) = [ 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 ] ! Local Variables integer ( int32 ) :: i , j , n real ( real64 ) :: Ti ( 4 , 4 ), T ( 4 , 4 ), Te ( 4 , 4 ), temp ( 4 , 4 ), di_1 ( 3 ), ki_1 ( 4 ) ! Initialization n = size ( alpha ) T = identity_4 () allocate ( rst ( 6 , n )) ! Process do i = 1 , n ! Compute the orientation vector ki_1 = matmul ( T , zi_1 ) ! Compute the link transformation matrix Ti = dh_matrix ( alpha ( i ), a ( i ), theta ( i ), d ( i )) ! Compute the transformation matrix relating the link to the end ! effector. Te = Ti do j = i + 1 , n temp = dh_matrix ( alpha ( j ), a ( j ), theta ( j ), d ( j )) Te = matmul ( Te , temp ) end do ! Compute the end-effector position vector di_1 = Te ( 1 : 3 , 4 ) ! Compute the Jacobian generating vector rst (:, i ) = jacobian_generating_vector ( di_1 , ki_1 ( 1 : 3 ), T ( 1 : 3 , 1 : 3 ), & jtypes ( i )) ! Update the transformation matrix T = matmul ( T , Ti ) end do end function ! ****************************************************************************** ! COORDINATE SYSTEM ROUTINES - V1.2.2 ADDITIONS ! ------------------------------------------------------------------------------ pure function define_link_csys ( xim1 , zim1 , zi , rim1 , ri ) & result ( rst ) !! Defines the DH coordinate system for the specified link. real ( real64 ), intent ( in ) :: xim1 ( 3 ) !! The x-axis of the previous link. real ( real64 ), intent ( in ) :: zim1 ( 3 ) !! The z-axis of the previous link. This is also the axis of the !! proximal joint of the current link. real ( real64 ), intent ( in ) :: zi ( 3 ) !! The axis of the distal joint of the current link. real ( real64 ), intent ( in ) :: rim1 ( 3 ) !! The location of the proximal joint's center or home position. real ( real64 ), intent ( in ) :: ri ( 3 ) !! The location of the distal joint's center or home position. type ( coordinate_system ) :: rst !! The resulting coordinate system. ! Local Variables logical :: intersect type ( line ) :: cn , lzim1 , lzi real ( real64 ) :: length , tol , pt0 ( 3 ) ! Initialization tol = 1.0d1 * epsilon ( tol ) ! zero tolerance lzim1 = line_from_point_and_vector ( rim1 , zim1 ) lzi = line_from_point_and_vector ( ri , zi ) ! Process call do_lines_intersect ( lzim1 , lzi , intersect ) if ( intersect ) then ! The two joint axes intersect. The x-axis as follows. rst % i = cross_product ( zim1 , zi ) ! Define the origin rst % origin = ri else ! Define the common normal between the two axes cn = line_common_normal ( lzim1 , lzi ) pt0 = cn % evaluate ( 1.0d0 ) length = norm2 ( pt0 - cn % evaluate ( 0.0d0 )) if ( length < tol ) then ! The axes are effectively colinear. The x-axis is chosen ! such that theta = 0 (i.e. the x axis is parallel with the ! previous x axis) rst % i = xim1 pt0 = ri else rst % i = cn % v end if ! The origin is the point of intersection of the common normal with ! the distal joint axis rst % origin = pt0 end if rst % i = rst % i / norm2 ( rst % i ) ! ensure i is a unit vector ! Store z, and normalize to a unit vector rst % k = zi / norm2 ( zi ) ! Compute y rst % j = cross_product ( rst % k , rst % i ) end function ! ------------------------------------------------------------------------------ pure function define_csys ( i , j , k , o ) result ( rst ) !! Defines a new coordinate_system object. It is the callers !! responsibility to ensure that the supplied vectors are orthogonal !! to one another. real ( real64 ), intent ( in ) :: i ( 3 ) !! The x-axis unit vector. real ( real64 ), intent ( in ) :: j ( 3 ) !! The y-axis unit vector. real ( real64 ), intent ( in ) :: k ( 3 ) !! The x-axis unit vector. real ( real64 ), intent ( in ), optional :: o ( 3 ) !! The location of the coordinate system within a reference !! coordinate system. If not supplied, a value of (0, 0, 0) will !! be used. type ( coordinate_system ) :: rst !! The new coordinate_system object. rst % i = i / norm2 ( i ) rst % j = j / norm2 ( j ) rst % k = k / norm2 ( k ) if ( present ( o )) then rst % origin = o else rst % origin = [ 0.0d0 , 0.0d0 , 0.0d0 ] end if end function ! ****************************************************************************** ! DENAVIT-HARTENBERG PARAMETER SET ROUTINES ! ------------------------------------------------------------------------------ pure function dps_init ( length , twist , offset , angle ) result ( rst ) !! Constructs a new dh_parameter_set object. real ( real64 ), intent ( in ) :: length !! The link length. real ( real64 ), intent ( in ) :: twist !! The link twist. real ( real64 ), intent ( in ) :: offset !! The link offset. real ( real64 ), intent ( in ) :: angle !! The joint angle. type ( dh_parameter_set ) :: rst !! The new dh_parameter_set object. rst % link_length = length rst % link_twist = twist rst % link_offset = offset rst % joint_angle = angle end function ! ****************************************************************************** ! DENAVIT-HARTENBERG TABLE ROUTINES ! ------------------------------------------------------------------------------ pure function dh_table_init ( c ) result ( rst ) !! Constructs a Denavit-Hartenberg table given the locations and !! orientations of a linkage. class ( coordinate_system ), intent ( in ), dimension (:) :: c !! An N-element array containing the coordinate frames for each !! of the N links of the linkage. type ( dh_table ) :: rst !! The resulting Denavit-Hartenberg table. ! Local Variables integer ( int32 ) :: i , n ! Initialization n = size ( c ) allocate ( rst % parameters ( n - 1 )) ! Process do i = 2 , n rst % parameters ( i - 1 )% link_length = & compute_dh_link_length ( c ( i - 1 ), c ( i )) rst % parameters ( i - 1 )% link_twist = & compute_dh_link_twist ( c ( i - 1 ), c ( i )) rst % parameters ( i - 1 )% link_offset = & compute_dh_link_offset ( c ( i - 1 ), c ( i )) rst % parameters ( i - 1 )% joint_angle = & compute_dh_joint_angle ( c ( i - 1 ), c ( i )) end do end function ! ------------------------------------------------------------------------------ pure function compute_dh_link_length ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg link length as the distance between !! the cs2 z-axis and the cs1 z-axis as measured along the cs2 x-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The link length. ! Local Variables real ( real64 ) :: v ( 3 ), pv ( 3 ) ! Compute a vector between the two coordinate system origins v = cs2 % origin - cs1 % origin ! Project the vector onto the cs2 x-axis pv = vector_projection ( v , cs2 % i ) ! The result is the length of the projected vector rst = norm2 ( pv ) end function ! ------------------------------------------------------------------------------ pure function compute_dh_link_twist ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg link twist as the required rotation !! of the cs1 z-axis about the cs2 x-axis to become parallel to the !! cs2 z-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The link twist angle, in radians. A positive angle is defined !! via the right-hand-rule. ! Local Variables real ( real64 ) :: pz1 ( 3 ), tol ! Initialization tol = 1.0d1 * epsilon ( tol ) ! Description: ! To compute the angle about the cs2 x-axis, the cs1 z-axis will be ! projected onto the plane formed by the cs2 y and z axes. The angle ! between the projected vector and the cs2 z-axis can then be ! determined. ! ! To project a vector onto a plane, assume we're projecting vector X ! onto plane P that has a unit normal N. The projected vector is then ! X - (X dot N) * N. For this instance, the normal vector of the cs2 ! y-z plane is the cs2 x-axis. pz1 = cs1 % k - dot_product ( cs1 % k , cs2 % i ) * cs2 % i ! Now, the angle between vectors may be determined. if ( norm2 ( pz1 ) < tol ) then ! The projected vector has a length of zero rst = 0.0d0 else ! Compute the angle rst = compute_vector_angle ( cs2 % i , cs2 % k , pz1 ) end if end function ! ------------------------------------------------------------------------------ pure function compute_dh_link_offset ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg link offset as the distance between !! the cs1 x-axis and the cs2 x-axis as measured along the cs1 z-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The link offset. ! Local Variables real ( real64 ) :: v ( 3 ), pv ( 3 ) ! Compute a vector between the two coordinate system origins v = cs2 % origin - cs1 % origin ! Project the vector onto the cs1 z-axis pv = vector_projection ( v , cs1 % k ) ! The result is the length of the projected vector rst = norm2 ( pv ) end function ! ------------------------------------------------------------------------------ pure function compute_dh_joint_angle ( cs1 , cs2 ) result ( rst ) !! Computes the Denavit-Hartenberg joint angle as rotation required of !! cs1 x-axis about the cs1 z-axis to become parallel to the cs2 x-axis. class ( coordinate_system ), intent ( in ) :: cs1 !! The previous coordinate frame. class ( coordinate_system ), intent ( in ) :: cs2 !! The current coordinate frame. real ( real64 ) :: rst !! The joint angle, in radians. A positive angle is defined !! via the right-hand-rule. ! Local Variables real ( real64 ) :: px2 ( 3 ), tol ! Initialization tol = 1.0d1 * epsilon ( tol ) ! Description: ! To compute the angle about the cs1 z-axis, the cs2 x-axis will be ! projected onto the plane formed by the cs1 x-y plane. The angle ! between the projected vector and the cs1 x-axis can then be ! determined. ! ! To project a vector onto a plane, assume we're projecting vector X ! onto plane P that has a unit normal N. The projected vector is then ! X - (X dot N) * N. For this instance, the normal vector of the cs1 ! x-y plane is the cs1 z-axis. px2 = cs2 % i - dot_product ( cs2 % i , cs1 % k ) * cs1 % k ! Now, the angle between vectors may be determined if ( norm2 ( px2 ) < tol ) then ! The projected vector has a length of zero rst = 0.0d0 else ! Compute the angle rst = compute_vector_angle ( - cs1 % k , cs1 % i , px2 ) end if end function ! ------------------------------------------------------------------------------ pure function compute_vector_angle ( axis , x , y ) result ( rst ) !! Computes the angle of rotation between two vectors as measured about !! the specified axis. real ( real64 ), intent ( in ) :: axis ( 3 ) !! The rotation axis. real ( real64 ), intent ( in ) :: x ( 3 ) !! The target vector. real ( real64 ), intent ( in ) :: y ( 3 ) !! The other vector. real ( real64 ) :: rst !! The angle, with correct sign assuming a right-hand convention. ! Parameters real ( real64 ), parameter :: half_pi = acos ( 0.0d0 ) ! Local Variables type ( quaternion ) :: q real ( real64 ) :: ry ( 3 ), xy , xymag , tol logical :: parallel ! Initialization tol = 1.0d1 * epsilon ( tol ) ! Determine the angle rst = vector_angle ( x , y ) ! To determine the sign, we can establish a quaternion and perform the ! rotation of one vector onto the other. q = quaternion ( rst , axis ) ! angle and axis construction ry = aimag ( q * y * conjg ( q )) xy = dot_product ( x , ry ) xymag = norm2 ( x ) * norm2 ( ry ) parallel = abs ( abs ( xy ) - xymag ) < tol if (. not . parallel ) then rst = - rst end if ! If the angle is pi/2, it is possible for the vectors to point ! in opposite directions but still pass the parallelism test if ( abs ( abs ( rst ) - half_pi ) < tol . and . xy < 0.0d0 ) then ! The vectors point in opposite directions rst = - rst end if end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_kinematics.f90.html"},{"title":"dynamics_linkage.f90 – DYNAMICS","text":"Contents Modules dynamics_linkage Source Code dynamics_linkage.f90 Source Code module dynamics_linkage use iso_fortran_env use dynamics_rigid_bodies use dynamics_kinematics use dynamics_geometry use dynamics_helper use dynamics_quaternions use collections , only : list use ferror , only : errors implicit none private public :: binary_link public :: serial_linkage type , extends ( rigid_body ) :: binary_link !! Defines a link consisting of only two joints. The coordinate system !! of this link is situated at the distal joint with it's z-axis !! coincident with the axis of the joint. The link utilizes a !! Denavit-Hartenberg convention in order to express its geometry. real ( real64 ), public :: link_length !! The link length is the distance between the proximal and distal !! joint axes as measured along the link's x-axis. real ( real64 ), public :: link_twist !! The link twist is the required rotation of the proximal joint !! axis about the link's x-axis to become parallel to the distal !! joint's axis. real ( real64 ), public :: link_offset !! The link offset is the fixed distance between the previous link's !! x-axis and the current link's x-axis as measured along the !! axis of the proximal joint. real ( real64 ), public :: joint_angle !! The joint angle is the required rotation of the previous link's !! x-axis about the proximal joint's axis to become parallel to the !! current link's x-axis. real ( real64 ), public :: joint_type !! The proximal joint type. This value must be either !! REVOLUTE_JOINT or PRISMATIC_JOINT. end type interface binary_link module procedure :: bl_init end interface type serial_linkage !! Defines a serial linkage. type ( list ), private :: m_links contains procedure , public :: get_link_count => sl_get_link_count procedure , public :: get_link => sl_get_link procedure , public :: forward_kinematics => sl_forward_kinematics procedure , public :: jacobian => sl_jacobian procedure , public :: inverse_kinematics => sl_inverse_kinematics_1 end type interface serial_linkage module procedure :: sl_init end interface type serial_linkage_solver_data ! An internal type used as a container to pass data to the inverse ! kinematics solver. type ( serial_linkage ), pointer :: linkage ! The serial_linkage object. real ( real64 ) :: target ( 4 , 4 ) ! The 4-by-4 target transformation matrix. end type contains ! ****************************************************************************** ! BINARY_LINK MEMBERS ! ------------------------------------------------------------------------------ pure function bl_init ( jtype , length , twist , offset , angle , & mass , inertia , cg ) result ( rst ) !! Initializes a new parallel_revolute_revolute_link instance. integer ( int32 ), intent ( in ), optional :: jtype !! The proximal joint type. This value must be either & !! REVOLUTE_JOINT or PRISMATIC_JOINT. If incorrectly specified, !! this parameter defaults to REVOLUTE_JOINT. real ( real64 ), intent ( in ), optional :: length !! The link length. If no value is specified, a value of 0 is used. real ( real64 ), intent ( in ), optional :: twist !! The link twist angle. If no value is specified, a value of 0 !! is used. real ( real64 ), intent ( in ), optional :: offset !! The link offset. If no value is specified, a value of 0 is used. real ( real64 ), intent ( in ), optional :: angle !! The joint angle offset. If no value is specified, a value of 0 !! is used. real ( real64 ), intent ( in ), optional :: mass !! The mass of the link. If no value is specified, a value of 1 is !! used. real ( real64 ), intent ( in ), optional :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor. If not specified, an identity matrix !! is used. real ( real64 ), intent ( in ), optional :: cg ( 3 ) !! The x-y-z location of the CG relative to the distal coordinate !! frame, expressed in the link coordinate frame. If not supplied, !! the CG is set to (0, 0, 0) such that it is located at the center !! of the distal joint. type ( binary_link ) :: rst !! The resulting binary_link object. ! Initialize the base object call initialize_rigid_body ( rst , mass , inertia , cg ) ! Additional initialization if ( present ( jtype )) then if ( jtype /= REVOLUTE_JOINT . and . jtype /= PRISMATIC_JOINT ) then rst % joint_type = REVOLUTE_JOINT else rst % joint_type = jtype end if else rst % joint_type = REVOLUTE_JOINT end if if ( present ( length )) then rst % link_length = length else rst % link_length = 0.0d0 end if if ( present ( twist )) then rst % link_twist = twist else rst % link_twist = 0.0d0 end if if ( present ( offset )) then rst % link_offset = offset else rst % link_offset = 0.0d0 end if if ( present ( angle )) then rst % joint_angle = angle else rst % joint_angle = 0.0d0 end if end function ! ****************************************************************************** ! SERIAL_LINKAGE MEMBERS ! ------------------------------------------------------------------------------ function sl_init ( lnks ) result ( rst ) !! Initializes a new serial_linkage object. class ( binary_link ), intent ( in ), dimension (:) :: lnks !! A collection of binary_link objects. The collection starts with !! the first link and progresses to the end-effector in a !! sequential manner. type ( serial_linkage ) :: rst !! The serial_linkage instance. ! Initialization integer ( int32 ) :: i , n n = size ( lnks ) do i = 1 , n call rst % m_links % push ( lnks ( i )) end do end function ! ------------------------------------------------------------------------------ pure function sl_get_link_count ( this ) result ( rst ) !! Gets the number of links in the linkage. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. integer ( int32 ) :: rst !! The link count. rst = this % m_links % count () end function ! ------------------------------------------------------------------------------ function sl_get_link ( this , i ) result ( rst ) !! Gets a pointer to the requested link object. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. integer ( int32 ), intent ( in ) :: i !! The index of the link to retrieve (1 = first link). class ( binary_link ), pointer :: rst !! A pointer to the requested link. ! Process class ( * ), pointer :: ptr ptr => this % m_links % get ( i ) rst => null () select type ( ptr ) class is ( binary_link ) rst => ptr end select end function ! ------------------------------------------------------------------------------ function sl_forward_kinematics ( this , q , err ) result ( rst ) use dynamics_error_handling , only : report_array_size_error !! Computes the forward kinematics for the linkage resulting in a !! transformation matrix between world and end-effector coordinate !! frames. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. real ( real64 ), intent ( in ), dimension (:) :: q !! The array of joint variables. This array must be the same size !! as there are number of links in this linkage. class ( errors ), intent ( inout ), optional , target :: err !! An errors-based object providing error handling in the event the !! array size is incorrect. real ( real64 ) :: rst ( 4 , 4 ) !! The resulting 4-by-4 transformation matrix. ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: qt , qd , T ( 4 , 4 ) class ( binary_link ), pointer :: lnk class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = this % get_link_count () rst = identity_4 () ! Input Checking if ( size ( q ) /= n ) then call report_array_size_error ( \"sl_forward_kinematics\" , \"q\" , n , & size ( q ), errmgr ) return end if ! Process do i = 1 , n ! Compute the link transformation matrix lnk => this % get_link ( i ) qd = lnk % link_offset qt = lnk % joint_angle if ( lnk % joint_type == PRISMATIC_JOINT ) then qd = qd + q ( i ) else qt = qt + q ( i ) end if T = dh_matrix ( lnk % link_twist , lnk % link_length , qt , qd ) ! Accumulate the transform rst = matmul ( rst , T ) end do end function ! ------------------------------------------------------------------------------ function sl_jacobian ( this , q , err ) result ( rst ) use dynamics_error_handling , only : report_array_size_error !! Constructs the Jacobian matrix for the linkage. The Jacobian matrix !! relates the joint velocities \\dot{\\vec{q}} to the end-effector !! velocity \\dot{\\vec{X}} by \\dot{\\vec{X}} = J \\dot{\\vec{q}}. class ( serial_linkage ), intent ( in ) :: this !! The serial_linkage object. real ( real64 ), intent ( in ), dimension (:) :: q !! The array of joint variables. This array must be the same size !! as there are number of links in this linkage. class ( errors ), intent ( inout ), optional , target :: err !! An errors-based object providing error handling in the event the !! array size is incorrect. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 6-by-N Jacobian matrix where N is the number of !! links in the linkage. ! Parameters real ( real64 ), parameter :: zi_1 ( 4 ) = [ 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 ] ! Local Variables integer ( int32 ) :: i , n real ( real64 ) :: qd , qt integer ( int32 ), allocatable , dimension (:) :: jtypes real ( real64 ), allocatable , dimension (:) :: a , alpha , theta , d class ( binary_link ), pointer :: lnk class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = this % get_link_count () ! Error Checking if ( size ( q ) /= n ) then call report_array_size_error ( \"sl_jacobian\" , \"q\" , n , size ( q ), errmgr ) return end if ! Format inputs for the Jacobian calculation allocate ( a ( n ), alpha ( n ), theta ( n ), d ( n ), jtypes ( n )) do i = 1 , n lnk => this % get_link ( i ) qd = lnk % link_offset qt = lnk % joint_angle if ( lnk % joint_type == PRISMATIC_JOINT ) then qd = qd + q ( i ) else qt = qt + q ( i ) end if a ( i ) = lnk % link_length alpha ( i ) = lnk % link_twist theta ( i ) = qt d ( i ) = qd jtypes ( i ) = lnk % joint_type end do ! Compute the Jacobian rst = dh_jacobian ( alpha , a , theta , d , jtypes ) end function ! ------------------------------------------------------------------------------ function sl_inverse_kinematics_1 ( this , qo , trg , ib , err ) result ( rst ) use dynamics_error_handling , only : report_array_size_error !! Solves the inverse kinematics problem for the linkage. class ( serial_linkage ), intent ( in ), target :: this !! The serial_linkage object. real ( real64 ), intent ( in ), dimension (:) :: qo !! An M-element array containing an initial estimate of the M joint !! variables. real ( real64 ), intent ( in ) :: trg ( 4 , 4 ) !! A transformation matrix relating the end-effector coordinate !! frame and the world coordinate frame. This transformation !! matrix defines the end-effector target for the solver. type ( iteration_behavior ), intent ( out ), optional :: ib !! An optional output that can be used to gather information on the !! solver. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object used to retrieve any errors !! regarding the solver. real ( real64 ), allocatable , dimension (:) :: rst !! An M-element array containing the computed joint variables that !! satisfy the constraints. ! Local Variables procedure ( vecfcn ), pointer :: vfcn type ( serial_linkage_solver_data ) :: obj real ( real64 ) :: constraints ( 6 ) class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if vfcn => sl_vecfcn obj % linkage => this obj % target = trg constraints ( 1 : 3 ) = trg ( 1 : 3 , 4 ) constraints ( 4 : 6 ) = 0.0d0 ! Input Check ! Can update this limit after solver and constraint technology improve if ( size ( qo ) > 6 ) then call report_array_size_error ( \"sl_inverse_kinematics_1\" , \"qo\" , 6 , & size ( qo ), errmgr ) return end if ! Process rst = solve_inverse_kinematics ( vfcn , qo , constraints , ib = ib , & args = obj , err = err ) end function ! ---------- subroutine sl_vecfcn ( x , f , args ) !! The subroutine passed to the inverse kinematics solver. real ( real64 ), intent ( in ), dimension (:) :: x !! The N joint variables real ( real64 ), intent ( out ), dimension (:) :: f !! The 6 kinematic constraint equations. class ( * ), intent ( inout ), optional :: args !! A container for the serial_linkage_solver_data object. ! Local Variables real ( real64 ) :: T ( 4 , 4 ), Re ( 3 , 3 ), R ( 3 , 3 ) ! Process select type ( args ) class is ( serial_linkage_solver_data ) ! Compute the forward kinematics of the linkage given the joint ! variables T = args % linkage % forward_kinematics ( x ) ! Evaluate the kinematics equations for position and orientation f ( 1 : 3 ) = T ( 1 : 3 , 4 ) ! The orientation components utilize an angle-axis approximation. ! The idea is to drive these 3 values to 0. Re = transpose ( T ( 1 : 3 , 1 : 3 )) R = matmul ( Re , args % target ( 1 : 3 , 1 : 3 )) f ( 4 ) = 0.5d0 * ( R ( 3 , 2 ) - R ( 2 , 3 )) f ( 5 ) = 0.5d0 * ( R ( 1 , 3 ) - R ( 3 , 1 )) f ( 6 ) = 0.5d0 * ( R ( 2 , 1 ) - R ( 1 , 2 )) end select end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_linkage.f90.html"},{"title":"dynamics_maps.f90 – DYNAMICS","text":"Contents Modules dynamics_maps Source Code dynamics_maps.f90 Source Code module dynamics_maps use iso_fortran_env use dynamics_geometry implicit none private public :: POINCARE_TWO_SIDED public :: POINCARE_ONE_SIDED_FROM_FRONT public :: POINCARE_ONE_SIDED_FROM_BACK public :: poincare_map integer ( int32 ), parameter :: POINCARE_TWO_SIDED = 0 !! A two-sided Poincare section will be computed. In this section, the !! algorithm does not care whether the trajectory approaches the !! sectioning plane from the front or the back of the plane (defined !! by the plane normal). It simply returns any intersection point. integer ( int32 ), parameter :: POINCARE_ONE_SIDED_FROM_FRONT = 1 !! A one-sided Poincare section will be computed where the algorithm !! only retains intersection points where the trajectory approaches !! the sectioning plane from the front (the side of the plane normal). integer ( int32 ), parameter :: POINCARE_ONE_SIDED_FROM_BACK = 2 !! A one-sided Poincare section will be computed where the algorithm !! only retains intersection points where the trajectory approaches !! the sectioning plane from the back (the side opposite the plane !! normal). contains ! ------------------------------------------------------------------------------ pure function poincare_map ( x , y , z , pln , side ) result ( rst ) !! Generates a Poincare map by determining the intersections of the !! supplied trajectory with the specified plane. real ( real64 ), intent ( in ), dimension (:) :: x !! The x-coordinates of the trajectory. real ( real64 ), intent ( in ), dimension ( size ( x )) :: y !! The y-coordinates of the trajectory. real ( real64 ), intent ( in ), dimension ( size ( x )) :: z !! The z-coordinates of the trajectory. class ( plane ), intent ( in ), optional :: pln !! The plane to intersect. If not supplied, the x-y plane is !! utilized where z = 0. integer ( int32 ), intent ( in ), optional :: side !! An integer flag denoting which approach to use when computing !! the section. The acceptable values are as follows. !! !! - POINCARE_TWO_SIDED (Default): A two-sided Poincare section !! will be computed. In this section, the algorithm does not care !! whether the trajectory approaches the sectioning plane from the !! front or the back of the plane (defined by the plane normal). !! It simply returns any intersection point. !! !! - POINCARE_ONE_SIDED_FROM_FRONT: A one-sided Poincare section !! will be computed where the algorithm only retains intersection !! points where the trajectory approaches the sectioning plane from !! the front (the side of the plane normal). !! !! - POINCARE_ONE_SIDED_FROM_BACK: A one-sided Poincare section !! will be computed where the algorithm only retains intersection !! points where the trajectory approaches the sectioning plane from !! the back (the side opposite the plane normal). real ( real64 ), allocatable , dimension (:,:) :: rst !! An N-by-3 matrix containing the x, y, and z coordinates of each !! of the N intersection points in the first, second, and third !! columns respectively. ! Local Variables logical :: from_back integer ( int32 ) :: i , j , n , s real ( real64 ) :: t , pt0 ( 3 ), pt1 ( 3 ), pt2 ( 3 ), v ( 3 ), pt ( 3 ) real ( real64 ), allocatable , dimension (:,:) :: buffer type ( plane ) :: p ! Initialization n = size ( x ) allocate ( buffer ( n , 3 )) if ( present ( pln )) then p = pln else ! XY Plane (point & normal) p = plane ([ 0.0d0 , 0.0d0 , 0.0d0 ], [ 0.0d0 , 0.0d0 , 1.0d0 ]) end if s = POINCARE_TWO_SIDED if ( present ( side )) then if ( side == POINCARE_ONE_SIDED_FROM_BACK ) then s = POINCARE_ONE_SIDED_FROM_BACK else if ( side == POINCARE_ONE_SIDED_FROM_FRONT ) then s = POINCARE_ONE_SIDED_FROM_FRONT end if end if ! Process j = 0 pt1 = [ x ( 1 ), y ( 1 ), z ( 1 )] do i = 2 , n ! Construct a line between the two points pt2 = [ x ( i ), y ( i ), z ( i )] v = pt2 - pt1 ! Determine the intersection with the plane by determining the ! parameter t. If the parameter t lies between 0 and 1 the point ! of intersection is between the two points and we can keep; else, ! it's not and we cannot keep t = - ( p % a * pt1 ( 1 ) + p % b * pt1 ( 2 ) + p % c * pt1 ( 3 ) + p % d ) / & dot_product ( plane_normal ( p ), v ) if ( t >= 0.0d0 . and . t <= 1.0d0 ) then pt = pt1 + t * v if ( s == POINCARE_TWO_SIDED ) then j = j + 1 buffer ( j ,:) = pt else if ( j > 2 ) then from_back = approach_from_behind ( p , pt1 , pt0 ) else from_back = approach_from_behind ( p , pt1 ) end if if ( from_back . and . s == POINCARE_ONE_SIDED_FROM_BACK ) then ! One sided - from back j = j + 1 buffer ( j ,:) = pt else if (. not . from_back . and . s == POINCARE_ONE_SIDED_FROM_FRONT ) then ! One sided - from front j = j + 1 buffer ( j ,:) = pt end if end if end if ! Update the next point pt0 = pt1 pt1 = pt2 end do rst = buffer ( 1 : j ,:) end function ! ------------------------------------------------------------------------------ pure function approach_from_behind ( pln , x1 , x2 ) result ( rst ) !! Determines if the trajectory approaches the sectioning plane from !! behind (true) or not (false) given the most recent point in the !! trajectory and the point prior. The point prior. class ( plane ), intent ( in ) :: pln !! The plane. real ( real64 ), intent ( in ) :: x1 ( 3 ) !! The most recent point in the trajectory prior to the trajectory !! intersecting the plane. real ( real64 ), intent ( in ), optional :: x2 ( 3 ) !! The point previos to x1 that is used only if x1 lies on the plane !! such that direction is indeterminate. logical :: rst !! Returns true if the trajectory approaches the plane from behind; !! else, false if the trajectory approaches the plane from in front. ! Local Variables real ( real64 ) :: val , tol ! Initialization tol = 1.0d1 * epsilon ( tol ) ! tolerance for a point on the plane ! Process val = pln % a * x1 ( 1 ) + pln % b * x1 ( 2 ) + pln % c * x1 ( 3 ) + pln % d if ( abs ( val ) < tol ) then ! The point lies on the plane if ( present ( x2 )) then ! Use the point previous to determine which side val = pln % a * x2 ( 1 ) + pln % b * x2 ( 2 ) + pln % c * x2 ( 3 ) + pln % d rst = val < 0.0d0 else rst = . false . ! default to this case in the event x2 is not given end if else rst = val < 0.0d0 ! the point approaches the plane from the side ! opposite the normal (from behind) if true end if end function ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_maps.f90.html"},{"title":"dynamics_quaternions.f90 – DYNAMICS","text":"Contents Modules dynamics_quaternions Source Code dynamics_quaternions.f90 Source Code module dynamics_quaternions use iso_fortran_env implicit none private public :: quaternion public :: operator ( + ) public :: operator ( - ) public :: operator ( * ) public :: operator ( / ) public :: assignment ( = ) public :: operator ( ** ) public :: abs public :: conjg public :: real public :: aimag public :: inverse public :: exp public :: log public :: dot_product type quaternion !! Defines a quaternion of the form: real ( real64 ) :: w !! The real component of the quaternion. real ( real64 ) :: x !! The first element in the imaginary component of the quaternion. real ( real64 ) :: y !! The second element in the imaginary component of the quaternion. real ( real64 ) :: z !! The third element in the imaginary component of the quaternion. contains procedure , public :: to_matrix => quat_to_matrix procedure , public :: normalize => quat_normalize procedure , public :: to_array => quat_to_vec4 procedure , public :: to_angle_axis => quat_to_angle_axis procedure , public :: to_roll_pitch_yaw => quat_to_rpy end type interface quaternion module procedure :: quat_init_array module procedure :: quat_init_angle_axis module procedure :: quat_init_mtx end interface interface operator ( + ) module procedure :: quat_add end interface interface operator ( - ) module procedure :: quat_subtract module procedure :: quat_negate end interface interface operator ( * ) module procedure :: quat_scalar_mult module procedure :: scalar_quat_mult module procedure :: quat_multiply module procedure :: quat_vec3_mult end interface interface operator ( / ) module procedure :: quat_scalar_div module procedure :: quat_divide end interface interface assignment ( = ) module procedure :: quat_assign module procedure :: quat_assign_vec4 end interface interface operator ( ** ) module procedure :: quat_pwr module procedure :: quat_int_pwr end interface interface abs module procedure :: quat_abs end interface interface conjg module procedure :: quat_conjg end interface interface real module procedure :: quat_real end interface interface aimag module procedure :: quat_aimag end interface interface exp module procedure :: quat_exp end interface interface log module procedure :: quat_log end interface interface dot_product module procedure :: quat_dot_prd end interface contains ! ------------------------------------------------------------------------------ pure function quat_init_array ( x ) result ( rst ) !! Constructs a quaternion from a 4-element array stored such that !! [w, x, y, z]. real ( real64 ), intent ( in ), dimension ( 4 ) :: x !! The array from which to initialize the quaternion stored in the !! order [w, x, y, z]. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x ( 1 ) rst % x = x ( 2 ) rst % y = x ( 3 ) rst % z = x ( 4 ) end function ! ------------------------------------------------------------------------------ pure function quat_init_angle_axis ( angle , axis ) result ( rst ) !! Constructs a quaternion given an axis and the angle of rotation about !! the axis. real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ), intent ( in ), dimension ( 3 ) :: axis !! A 3-element vector defining the axis about which the rotation !! occurrs. type ( quaternion ) :: rst !! The resulting quaternion. real ( real64 ) :: s s = sin ( 0.5d0 * angle ) rst % w = cos ( 0.5d0 * angle ) rst % x = s * axis ( 1 ) rst % y = s * axis ( 2 ) rst % z = s * axis ( 3 ) end function ! ------------------------------------------------------------------------------ pure function quat_init_mtx ( r ) result ( rst ) !! Constructs a quaternion from a 3-by-3 rotation matrix using the !! Stanley method. real ( real64 ), intent ( in ), dimension ( 3 , 3 ) :: r !! The rotation matrix. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables integer ( int32 ) :: ind real ( real64 ) :: esq ( 4 ), e0 , e1 , e2 , e3 ! Process esq ( 1 ) = 0.25d0 * ( 1.0d0 + r ( 1 , 1 ) + r ( 2 , 2 ) + r ( 3 , 3 )) esq ( 2 ) = 0.25d0 * ( 1.0d0 + r ( 1 , 1 ) - r ( 2 , 2 ) - r ( 3 , 3 )) esq ( 3 ) = 0.25d0 * ( 1.0d0 - r ( 1 , 1 ) + r ( 2 , 2 ) - r ( 3 , 3 )) esq ( 4 ) = 0.25d0 * ( 1.0d0 - r ( 1 , 1 ) - r ( 2 , 2 ) + r ( 3 , 3 )) ind = maxloc ( esq , 1 ) select case ( ind ) case ( 1 ) e0 = sqrt ( esq ( 1 )) e1 = 0.25d0 * ( r ( 3 , 2 ) - r ( 2 , 3 )) / e0 e2 = 0.25d0 * ( r ( 1 , 3 ) - r ( 3 , 1 )) / e0 e3 = 0.25d0 * ( r ( 2 , 1 ) - r ( 1 , 2 )) / e0 case ( 2 ) e1 = sqrt ( esq ( 2 )) e0 = 0.25d0 * ( r ( 3 , 2 ) - r ( 2 , 3 )) / e1 e2 = 0.25d0 * ( r ( 1 , 2 ) + r ( 2 , 1 )) / e1 e3 = 0.25d0 * ( r ( 1 , 3 ) + r ( 3 , 1 )) / e1 case ( 3 ) e2 = sqrt ( esq ( 3 )) e0 = 0.25d0 * ( r ( 1 , 3 ) - r ( 3 , 1 )) / e2 e1 = 0.25d0 * ( r ( 1 , 2 ) + r ( 2 , 1 )) / e2 e3 = 0.25d0 * ( r ( 2 , 3 ) + r ( 3 , 2 )) / e2 case default e3 = sqrt ( esq ( 4 )) e0 = 0.25d0 * ( r ( 2 , 1 ) - r ( 1 , 2 )) / e3 e1 = 0.25d0 * ( r ( 1 , 3 ) + r ( 3 , 1 )) / e3 e2 = 0.25d0 * ( r ( 2 , 3 ) + r ( 3 , 2 )) / e3 end select rst % w = e0 rst % x = e1 rst % y = e2 rst % z = e3 end function ! ------------------------------------------------------------------------------ pure elemental function quat_add ( x , y ) result ( rst ) !! Adds two quaternions together. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x % w + y % w rst % x = x % x + y % x rst % y = x % y + y % y rst % z = x % z + y % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_subtract ( x , y ) result ( rst ) !! Subtracts two quaternions. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x % w - y % w rst % x = x % x - y % x rst % y = x % y - y % y rst % z = x % z - y % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_scalar_mult ( x , y ) result ( rst ) !! Multiplies a quaternion with a scalar. type ( quaternion ), intent ( in ) :: x !! The quaternion. real ( real64 ), intent ( in ) :: y !! The scalar. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = y * x % w rst % x = y * x % x rst % y = y * x % y rst % z = y * x % z end function ! ------------------------------------------------------------------------------ pure elemental function scalar_quat_mult ( x , y ) result ( rst ) !! Multiplies a quaternion with a scalar. real ( real64 ), intent ( in ) :: x !! The scalar. type ( quaternion ), intent ( in ) :: y !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x * y % w rst % x = x * y % x rst % y = x * y % y rst % z = x * y % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_multiply ( x , y ) result ( rst ) !! Multiplies two quaternions. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: x0 , x1 , x2 , x3 , y0 , y1 , y2 , y3 ! Initialization x0 = x % w x1 = x % x x2 = x % y x3 = x % z y0 = y % w y1 = y % x y2 = y % y y3 = y % z ! Process rst % w = x0 * y0 - x1 * y1 - x2 * y2 - x3 * y3 rst % x = y0 * x1 + y1 * x0 - y2 * x3 + y3 * x2 rst % y = y0 * x2 + x0 * y2 + y1 * x3 - x1 * y3 rst % z = y0 * x3 - y1 * x2 + x0 * y3 + y2 * x1 end function ! ------------------------------------------------------------------------------ pure function quat_vec3_mult ( x , y ) result ( rst ) !! Multiplies a quaternion with a 3-element vector. type ( quaternion ), intent ( in ) :: x !! The quaternion. real ( real64 ), intent ( in ), dimension ( 3 ) :: y !! The vector. type ( quaternion ) :: rst !! The resulting quaternion. rst = x * quaternion ([ 0.0d0 , y ( 1 ), y ( 2 ), y ( 3 )]) end function ! ------------------------------------------------------------------------------ pure elemental function quat_scalar_div ( x , y ) result ( rst ) !! Divides a quaternion by a scalar. type ( quaternion ), intent ( in ) :: x !! The quaternion. real ( real64 ), intent ( in ) :: y !! The scalar. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = x % w / y rst % x = x % x / y rst % y = x % y / y rst % z = x % z / y end function ! ------------------------------------------------------------------------------ pure elemental function quat_divide ( x , y ) result ( rst ) !! Divides a quaternion by another. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. type ( quaternion ) :: rst !! The resulting quaternion. rst = x * inverse ( y ) end function ! ------------------------------------------------------------------------------ pure elemental subroutine quat_assign ( x , y ) !! Assigns a quaternion to another. type ( quaternion ), intent ( out ) :: x !! The resulting quaternion. type ( quaternion ), intent ( in ) :: y !! The source quaternion. x % w = y % w x % x = y % x x % y = y % y x % z = y % z end subroutine ! ------------------------------------------------------------------------------ pure subroutine quat_assign_vec4 ( x , y ) !! Assigns a 4-element vector to a quaternion. type ( quaternion ), intent ( out ) :: x !! The resulting quaternion. real ( real64 ), intent ( in ), dimension ( 4 ) :: y !! The source vector. x % w = y ( 1 ) x % x = y ( 2 ) x % y = y ( 3 ) x % z = y ( 4 ) end subroutine ! ------------------------------------------------------------------------------ pure elemental function quat_negate ( x ) result ( rst ) !! Negates a quaternion. type ( quaternion ), intent ( in ) :: x !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. rst % w = - x % w rst % x = - x % x rst % y = - x % y rst % z = - x % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_abs ( q ) result ( rst ) !! Computes the magnitude of a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ) :: rst !! The magnitude of the quaternion. real ( real64 ) :: x ( 4 ) x = [ q % w , q % x , q % y , q % z ] rst = norm2 ( x ) end function ! ------------------------------------------------------------------------------ pure elemental function quat_conjg ( q ) result ( rst ) !! Computes the conjugate of a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The conjugate of the quaternion. rst % w = q % w rst % x = - q % x rst % y = - q % y rst % z = - q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_real ( q ) result ( rst ) !! Returns the real component of the quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ) :: rst !! The real component. rst = q % w end function ! ------------------------------------------------------------------------------ pure function quat_aimag ( q ) result ( rst ) !! Returns the imaginary component of the quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), dimension ( 3 ) :: rst !! The imaginary component as a vector. rst = [ q % x , q % y , q % z ] end function ! ------------------------------------------------------------------------------ pure elemental function inverse ( q ) result ( rst ) !! Computes the inverse of a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The inverse of the supplied quaternion. rst = conjg ( q ) / ( abs ( q ) ** 2 ) end function ! ------------------------------------------------------------------------------ pure elemental function quat_exp ( q ) result ( rst ) !! Evaluates the exponential function for a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: qmag , arg , s ! Process qmag = norm2 ( aimag ( q )) arg = exp ( q % w ) s = arg * sin ( qmag ) / qmag rst % w = arg * cos ( qmag ) rst % x = s * q % x rst % y = s * q % y rst % z = s * q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_log ( q ) result ( rst ) !! Evalautes the natural logarithm function for a quaternion. type ( quaternion ), intent ( in ) :: q !! The quaternion. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: qmag , vmag , arg ! Process qmag = abs ( q ) vmag = norm2 ( aimag ( q )) arg = acos ( q % w / qmag ) / vmag rst % w = log ( qmag ) rst % x = arg * q % x rst % y = arg * q % y rst % z = arg * q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_pwr ( q , exponent ) result ( rst ) !! Computes the result of a quaternion raised to an exponent. type ( quaternion ), intent ( in ) :: q !! The quaternion base. real ( real64 ), intent ( in ) :: exponent !! The exponent. type ( quaternion ) :: rst !! The resulting quaternion. ! Local Variables real ( real64 ) :: qmag , vmag , phi , arg , s ! Process qmag = abs ( q ) vmag = norm2 ( aimag ( q )) phi = acos ( q % w / qmag ) arg = qmag ** exponent s = arg * sin ( exponent * phi ) / vmag rst % w = arg * cos ( exponent * phi ) rst % x = s * q % x rst % y = s * q % y rst % z = s * q % z end function ! ------------------------------------------------------------------------------ pure elemental function quat_int_pwr ( q , exponent ) result ( rst ) !! Computes the result of a quaternion raised to an exponent. type ( quaternion ), intent ( in ) :: q !! The quaternion base. integer ( int32 ), intent ( in ) :: exponent !! The exponent. type ( quaternion ) :: rst !! The resulting quaternion. rst = quat_pwr ( q , real ( exponent , real64 )) end function ! ------------------------------------------------------------------------------ pure elemental function quat_dot_prd ( x , y ) result ( rst ) !! Computes the dot product of two quaternions. type ( quaternion ), intent ( in ) :: x !! The left-hand-side argument. type ( quaternion ), intent ( in ) :: y !! The right-hand-side argument. real ( real64 ) :: rst !! The dot product. rst = x % w * y % w + x % x * y % x + x % y * y % y + x % z * y % z end function ! ****************************************************************************** ! MEMBER ROUTINES ! ------------------------------------------------------------------------------ pure function quat_to_matrix ( q ) result ( rst ) !! Converts the quaternion to a 3-by-3 rotation matrix. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), dimension ( 3 , 3 ) :: rst !! The resulting rotation matrix. ! Local Variables type ( quaternion ) :: qnorm real ( real64 ) :: e0 , e1 , e2 , e3 ! Process qnorm = q / abs ( q ) e0 = qnorm % w e1 = qnorm % x e2 = qnorm % y e3 = qnorm % z rst ( 1 , 1 ) = e0 ** 2 + e1 ** 2 - e2 ** 2 - e3 ** 2 rst ( 2 , 1 ) = 2.0d0 * ( e0 * e3 + e1 * e2 ) rst ( 3 , 1 ) = 2.0d0 * ( e1 * e3 - e0 * e2 ) rst ( 1 , 2 ) = 2.0d0 * ( e1 * e2 - e0 * e3 ) rst ( 2 , 2 ) = e0 ** 2 - e1 ** 2 + e2 ** 2 - e3 ** 2 rst ( 3 , 2 ) = 2.0d0 * ( e0 * e1 + e2 * e3 ) rst ( 1 , 3 ) = 2.0d0 * ( e0 * e2 + e1 * e3 ) rst ( 2 , 3 ) = 2.0d0 * ( e2 * e3 - e0 * e1 ) rst ( 3 , 3 ) = e0 ** 2 - e1 ** 2 - e2 ** 2 + e3 ** 2 end function ! ------------------------------------------------------------------------------ pure subroutine quat_normalize ( q ) !! Normalizes the quaternion. class ( quaternion ), intent ( inout ) :: q !! On input, the quaternion to normalize. On output, the normalized !! quaternion. ! Local Variables real ( real64 ) :: mag ! Process mag = abs ( q ) q % w = q % w / mag q % x = q % x / mag q % y = q % y / mag q % z = q % z / mag end subroutine ! ------------------------------------------------------------------------------ pure function quat_to_vec4 ( q ) result ( rst ) !! Converts a quaternion to a 4-element array of the form [w, x, y, z]. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), dimension ( 4 ) :: rst !! The array of the form [w, x, y, z]. rst = [ q % w , q % x , q % y , q % z ] end function ! ------------------------------------------------------------------------------ pure subroutine quat_to_angle_axis ( q , angle , axis ) !! Converts the quaternion to the equivalent angle-axis form. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), intent ( out ) :: angle !! The rotation angle, in radians. real ( real64 ), intent ( out ) :: axis ( 3 ) !! The axis of rotation. ! Process real ( real64 ) :: qnorm , enorm qnorm = abs ( q ) enorm = norm2 ( aimag ( q )) axis = aimag ( q ) / enorm angle = 2.0d0 * atan2 ( enorm , q % w / qnorm ) end subroutine ! ------------------------------------------------------------------------------ pure subroutine quat_to_rpy ( q , roll , pitch , yaw ) !! Converts the quaternion to the equivalent Euler angles of roll, !! pitch, and yaw. class ( quaternion ), intent ( in ) :: q !! The quaternion. real ( real64 ), intent ( out ) :: roll !! The roll angle (rotation about the body x-axis), in radians. real ( real64 ), intent ( out ) :: pitch !! The pitch angle (rotation about the body y-axis), in radians. real ( real64 ), intent ( out ) :: yaw !! The yaw angle (rotation about the body z-axis), in radians. ! Local Variables real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) real ( real64 ) :: qmag , qx , qy , qz , qw ! Process qmag = abs ( q ) qw = q % w / qmag qx = q % x / qmag qy = q % y / qmag qz = q % z / qmag roll = atan2 ( 2.0d0 * ( qw * qx + qy * qz ), 1.0d0 - 2.0d0 * ( qx ** 2 + qy ** 2 )) pitch = - 0.5d0 * pi + 2.0d0 * & atan2 ( sqrt ( 1.0d0 + 2.0d0 * ( qw * qy - qx * qz )), & sqrt ( 1.0d0 - 2.0d0 * ( qw * qy - qx * qz ))) yaw = atan2 ( 2.0d0 * ( qw * qz + qx * qy ), 1.0d0 - 2.0d0 * ( qy ** 2 + qz ** 2 )) end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_quaternions.f90.html"},{"title":"dynamics_rigid_bodies.f90 – DYNAMICS","text":"Contents Modules dynamics_rigid_bodies Source Code dynamics_rigid_bodies.f90 Source Code module dynamics_rigid_bodies use iso_fortran_env implicit none private public :: rigid_body public :: initialize_rigid_body type rigid_body !! Defines a rigid body. real ( real64 ), public :: mass !! The mass of the body. real ( real64 ), public :: cg ( 3 ) !! The x-y-z location of the CG relative to the body coordinate !! frame. real ( real64 ), public :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor as measured about the CG of the body. end type interface rigid_body module procedure :: rb_init end interface contains ! ------------------------------------------------------------------------------ pure function rb_init ( m , inertia , cg ) result ( rst ) !! Initializes a rigid_body object. real ( real64 ), intent ( in ), optional :: m !! The mass of the body. If no mass is specified, a value of 1 is used. real ( real64 ), intent ( in ), optional :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor. If not supplied, an identity matrix !! is used. real ( real64 ), intent ( in ), optional :: cg ( 3 ) !! The x-y-z location of the CG relative to the body coordinate frame. !! If not supplied, the CG is set to (0, 0, 0). type ( rigid_body ) :: rst !! The rigid_body object. call initialize_rigid_body ( rst , m , inertia , cg ) end function ! ------------------------------------------------------------------------------ pure subroutine initialize_rigid_body ( bdy , m , inertia , cg ) !! Initializes a rigid_body object. class ( rigid_body ), intent ( inout ) :: bdy !! The rigid_body object. real ( real64 ), intent ( in ), optional :: m !! The mass of the body. If no mass is specified, a value of 1 is used. real ( real64 ), intent ( in ), optional :: inertia ( 3 , 3 ) !! The 3-by-3 inertia tensor. If not supplied, an identity matrix !! is used. real ( real64 ), intent ( in ), optional :: cg ( 3 ) !! The x-y-z location of the CG relative to the body coordinate frame. !! If not supplied, the CG is set to (0, 0, 0). if ( present ( m )) then bdy % mass = m else bdy % mass = 1.0d0 end if if ( present ( inertia )) then bdy % inertia = inertia else bdy % inertia = reshape ( & [ 1.0d0 , 0.0d0 , 0.0d0 , & 0.0d0 , 1.0d0 , 0.0d0 , & 0.0d0 , 0.0d0 , 1.0d0 ], & [ 3 , 3 ] & ) end if if ( present ( cg )) then bdy % cg = cg else bdy % cg = 0.0d0 end if end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_rigid_bodies.f90.html"},{"title":"dynamics_rotation.f90 – DYNAMICS","text":"Contents Modules dynamics_rotation Source Code dynamics_rotation.f90 Source Code module dynamics_rotation use iso_fortran_env use dynamics_helper implicit none private public :: rotate_x public :: rotate_y public :: rotate_z public :: rotate public :: acceleration_transform public :: velocity_transform public :: to_angle_axis interface rotate module procedure :: rotate_general_1 module procedure :: rotate_general_2 end interface contains ! ------------------------------------------------------------------------------ pure function rotate_x ( angle ) result ( rst ) !! Constructs the rotation matrix describing a rotation about an !! x-axis such that !! \\overrightarrow{r_2} = \\textbf{R}_x \\overrightarrow{r_1} . !! !! \\textbf{R}_x = \\left[ \\begin{matrix} 1 & 0 & 0 \\\\ 0 & !! \\cos{\\theta_x} & -\\sin{\\theta_x} \\\\ 0 & \\sin{\\theta_x} & !! \\cos{\\theta_x} \\\\ \\end{matrix} \\right] real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. ! Local Variables real ( real64 ) :: c , s ! Process c = cos ( angle ) s = sin ( angle ) rst = reshape ([ 1.0d0 , 0.0d0 , 0.0d0 , 0.0d0 , c , s , 0.0d0 , - s , c ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function rotate_y ( angle ) result ( rst ) !! Constructs the rotation matrix describing a rotation about a y-axis !! such that !! \\overrightarrow{r_2} = \\textbf{R}_y \\overrightarrow{r_1} . !! !! \\textbf{R}_y = \\left[ \\begin{matrix} \\cos{\\theta_y} & 0 & !! \\sin{\\theta_y} \\\\ 0 & 1 & 0 \\\\ -\\sin{\\theta_y} & 0 & !! \\cos{\\theta_y} \\\\ \\end{matrix} \\right] real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. ! Local Variables real ( real64 ) :: c , s ! Process c = cos ( angle ) s = sin ( angle ) rst = reshape ([ c , 0.0d0 , - s , 0.0d0 , 1.0d0 , 0.0d0 , s , 0.0d0 , c ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function rotate_z ( angle ) result ( rst ) !! Constructs the rotation matrix describing a rotation about a y-axis !! such that !! \\overrightarrow{r_2} = \\textbf{R}_z \\overrightarrow{r_1} . !! !! \\textbf{R}_z = \\left[ \\begin{matrix} \\cos{\\theta_z} & !! -\\sin{\\theta_z} & 0 \\\\ \\sin{\\theta_z} & \\cos{\\theta_z} & 0 \\\\ !! 0 & 0 & 1 \\\\ \\end{matrix} \\right] real ( real64 ), intent ( in ) :: angle !! The rotation angle, in radians. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. ! Local Variables real ( real64 ) :: c , s ! Process c = cos ( angle ) s = sin ( angle ) rst = reshape ([ c , s , 0.0d0 , - s , c , 0.0d0 , 0.0d0 , 0.0d0 , 1.0d0 ], [ 3 , 3 ]) end function ! ------------------------------------------------------------------------------ pure function rotate_general_1 ( i , j , k , Ip , Jp , Kp ) result ( rst ) !! Constructs a rotation matrix when the orientation of the coordinate !! frame of interest is known relative to the parent coordinate frame. !! !! The matrix is of the following form. !! !! \\textbf{R} = \\left[ \\begin{matrix} !! \\vec{I_p} \\cdot \\vec{i} & \\vec{I_p} \\cdot \\vec{j} & !! \\vec{I_p} \\cdot \\vec{k} \\\\ \\vec{J_p} \\cdot \\vec{i} & !! \\vec{J_p} \\cdot \\vec{j} & \\vec{J_p} \\cdot \\vec{k} \\\\ !! \\vec{K_p} \\cdot \\vec{i} & \\vec{K_p} \\cdot \\vec{j} & !! \\vec{K_p} \\cdot \\vec{k} \\\\ \\end{matrix} \\right] !! !! This routine does not check for orthogonallity or unit vector length; !! therefore, to ensure correct results it is the callers responsibility !! to ensure each vector is of unit length and that the unit vectors !! are properly orthogonal. real ( real64 ), intent ( in ) :: i ( 3 ) !! The rotated coordinate frame x-axis unit vector. real ( real64 ), intent ( in ) :: j ( 3 ) !! The rotated coordinate frame y-axis unit vector. real ( real64 ), intent ( in ) :: k ( 3 ) !! The rotated coordinate frame z-axis unit vector. real ( real64 ), intent ( in ) :: Ip ( 3 ) !! The parent coordinate frame x-axis unit vector. real ( real64 ), intent ( in ) :: Jp ( 3 ) !! The parent coordinate frame y-axis unit vector. real ( real64 ), intent ( in ) :: Kp ( 3 ) !! The parent coordinate frame z-axis unit vector. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. rst ( 1 , 1 ) = dot_product ( Ip , i ) rst ( 2 , 1 ) = dot_product ( Jp , i ) rst ( 3 , 1 ) = dot_product ( Kp , i ) rst ( 1 , 2 ) = dot_product ( Ip , j ) rst ( 2 , 2 ) = dot_product ( Jp , j ) rst ( 3 , 2 ) = dot_product ( Kp , j ) rst ( 1 , 3 ) = dot_product ( Ip , k ) rst ( 2 , 3 ) = dot_product ( Jp , k ) rst ( 3 , 3 ) = dot_product ( Kp , k ) end function ! ------------------------------------------------------------------------------ pure function rotate_general_2 ( i , j , k ) result ( rst ) !! Constructs a rotation matrix when the orientation of the coordinate !! frame of interest is known relative to the parent coordinate frame. !! !! The matrix is of the following form. !! !! \\textbf{R} = \\left[ \\begin{matrix} !! \\vec{I_p} \\cdot \\vec{i} & \\vec{I_p} \\cdot \\vec{j} & !! \\vec{I_p} \\cdot \\vec{k} \\\\ \\vec{J_p} \\cdot \\vec{i} & !! \\vec{J_p} \\cdot \\vec{j} & \\vec{J_p} \\cdot \\vec{k} \\\\ !! \\vec{K_p} \\cdot \\vec{i} & \\vec{K_p} \\cdot \\vec{j} & !! \\vec{K_p} \\cdot \\vec{k} \\\\ \\end{matrix} \\right] !! !! The parent coordinate frame is assumed to be as follows. !! !! \\vec{I_p} = \\left( \\begin{matrix} 1 & 0 & 0 \\end{matrix} \\right) !! !! \\vec{J_p} = \\left( \\begin{matrix} 0 & 1 & 0 \\end{matrix} \\right) !! !! \\vec{K_p} = \\left( \\begin{matrix} 0 & 0 & 1 \\end{matrix} \\right) !! !! This routine does not check for orthogonallity or unit vector length; !! therefore, to ensure correct results it is the callers responsibility !! to ensure each vector is of unit length and that the unit vectors !! are properly orthogonal. real ( real64 ), intent ( in ) :: i ( 3 ) !! The rotated coordinate frame x-axis unit vector. real ( real64 ), intent ( in ) :: j ( 3 ) !! The rotated coordinate frame y-axis unit vector. real ( real64 ), intent ( in ) :: k ( 3 ) !! The rotated coordinate frame z-axis unit vector. real ( real64 ) :: rst ( 3 , 3 ) !! The resulting 3-by-3 matrix. rst = rotate_general_1 ( i , j , k , [ 1.0d0 , 0.0d0 , 0.0d0 ], & [ 0.0d0 , 1.0d0 , 0.0d0 ], [ 0.0d0 , 0.0d0 , 1.0d0 ]) end function ! ------------------------------------------------------------------------------ pure subroutine to_angle_axis ( r , angle , axis ) !! Extracts the equivalent rotation angle and axis of rotation given a !! 3-by-3 rotation matrix. real ( real64 ), intent ( in ) :: r ( 3 , 3 ) !! The 3-by-3 rotation matrix. real ( real64 ), intent ( out ) :: angle !! The rotation angle. real ( real64 ), intent ( out ) :: axis ( 3 ) !! The axis of rotation. ! Process real ( real64 ) :: u ( 3 , 3 ) angle = acos ( 0.5d0 * ( r ( 1 , 1 ) + r ( 2 , 2 ) + r ( 3 , 3 ) - 1.0d0 )) u = ( r - transpose ( r )) / ( 2.0d0 * sin ( angle )) ! this is skew symmetric axis = [ u ( 3 , 2 ), u ( 1 , 3 ), u ( 2 , 1 )] axis = axis / norm2 ( axis ) ! normalize to a unit vector end subroutine ! ****************************************************************************** ! REVISION 1.0.8 ADDITIONS ! ------------------------------------------------------------------------------ pure function acceleration_transform ( alpha , omega , a , x ) result ( rst ) !! Computes the acceleration transformation matrix relating the !! position of a point expressed in a rotating and translating body !! relative to its parent frame. !! !! The transformation matrix takes the following form. !! !! A = \\left[ \\begin{matrix} \\tilde{\\alpha} - \\tilde{\\omega} !! \\tilde{\\omega}^{T} & \\vec{a} - \\left( \\tilde{\\alpha} - \\tilde{\\omega} !! \\tilde{\\omega}^{T} \\right) \\vec{x} \\\\ 0 & 0 \\end{matrix} \\right] !! !! where, !! !! \\tilde{\\alpha} = \\left[ \\begin{matrix} 0 & -\\alpha_z & \\alpha_y \\\\ !! \\alpha_z & 0 & -\\alpha_x \\\\ -\\alpha_y & \\alpha_x & 0 \\end{matrix} !! \\right] !! !! and, !! !! \\tilde{\\omega} = \\left[ \\begin{matrix} 0 & -\\omega_z & \\omega_y \\\\ !! \\omega_z & 0 & -\\omega_x \\\\ -\\omega_y & \\omega_x & 0 \\end{matrix} !! \\right] !! !! Given a vector describing the location on a moving body, !! \\vec{r_p}, the matrix is used to report its acceleration !! \\vec{a_p} = A \\vec{r_p}. real ( real64 ), intent ( in ) :: alpha ( 3 ) !! The angular acceleration vector. real ( real64 ), intent ( in ) :: omega ( 3 ) !! The angular velocity vector. real ( real64 ), intent ( in ) :: a ( 3 ) !! The translational acceleration vector describing the acceleration !! of the body in its parent coordinate frame. real ( real64 ), intent ( in ) :: x ( 3 ) !! The position vector of the body in its parent coordinate frame. real ( real64 ) :: rst ( 4 , 4 ) !! The 4-by-4 transformation matrix. ! Compute alpha = alpha - omega * omega**T rst ( 1 , 1 ) = - omega ( 3 ) ** 2 - omega ( 2 ) ** 2 rst ( 2 , 1 ) = omega ( 1 ) * omega ( 2 ) + alpha ( 3 ) rst ( 3 , 1 ) = omega ( 1 ) * omega ( 3 ) - alpha ( 2 ) rst ( 4 , 1 ) = 0.0d0 rst ( 1 , 2 ) = omega ( 1 ) * omega ( 2 ) - alpha ( 3 ) rst ( 2 , 2 ) = - omega ( 3 ) ** 2 - omega ( 1 ) ** 2 rst ( 3 , 2 ) = omega ( 2 ) * omega ( 3 ) + alpha ( 1 ) rst ( 4 , 2 ) = 0.0d0 rst ( 1 , 3 ) = omega ( 1 ) * omega ( 3 ) + alpha ( 2 ) rst ( 2 , 3 ) = omega ( 2 ) * omega ( 3 ) - alpha ( 1 ) rst ( 3 , 3 ) = - omega ( 2 ) ** 2 - omega ( 1 ) ** 2 rst ( 4 , 3 ) = 0.0d0 ! Compute a - (alpha - omega * omega**T) x rst ( 1 : 3 , 4 ) = a - matmul ( rst ( 1 : 3 , 1 : 3 ), x ) rst ( 4 , 4 ) = 0.0d0 end function ! ------------------------------------------------------------------------------ pure function velocity_transform ( omega , v , x ) result ( rst ) !! Computes the velocity transformation matrix relating the position !! of a point expressed in a rotating and translating body relative to !! its parent frame. !! !! The transformation matrix takes the following form. !! !! V = \\left[ \\begin{matrix} \\tilde{\\omega} & \\vec{v} - !! \\tilde{\\omega} \\vec{x} \\\\ 0 & 0 \\end{matrix} \\right] !! !! where, !! !! \\tilde{\\omega} = \\left[ \\begin{matrix} 0 & -\\omega_z & \\omega_y \\\\ !! \\omega_z & 0 & -\\omega_x \\\\ -\\omega_y & \\omega_x & 0 \\end{matrix} !! \\right] !! !! Given a vector describing the location on a moving body, !! \\vec{r_p}, the matrix is used to report its velocity !! \\vec{v_p} = V \\vec{r_p}. real ( real64 ), intent ( in ) :: omega ( 3 ) !! The angular velocity vector. real ( real64 ), intent ( in ) :: v ( 3 ) !! The translation velocity vector describing the velocity of the !! body in its parent coordinate frame. real ( real64 ), intent ( in ) :: x ( 3 ) !! The position vector of the body in its parent coordinate frame. real ( real64 ) :: rst ( 4 , 4 ) !! The 4-by-4 transformation matrix. ! Process rst ( 1 : 3 , 1 : 3 ) = to_skew_symmetric ( omega ) rst ( 1 : 3 , 4 ) = v - matmul ( rst ( 1 : 3 , 1 : 3 ), x ) rst ( 4 ,:) = 0.0d0 end function end module","tags":"","loc":"sourcefile\\dynamics_rotation.f90.html"},{"title":"dynamics_stability.f90 – DYNAMICS","text":"Contents Modules dynamics_stability Source Code dynamics_stability.f90 Source Code module dynamics_stability use iso_fortran_env use ferror use dynamics_error_handling use linalg , only : eigen implicit none private public :: HYPERBOLIC_FIXED_POINT_SINK public :: HYPERBOLIC_FIXED_POINT_SOURCE public :: HYPERBOLIC_FIXED_POINT_SADDLE public :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE public :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE public :: NONHYPERBOLIC_FIXED_POINT_CENTER public :: determine_local_stability integer ( int32 ), parameter :: HYPERBOLIC_FIXED_POINT_SINK = 100 !! Describes a hyperbolic fixed point where all of the eigenvalues of !! the dynamics matrix have a nonzero real part and all real parts are !! negative-valued. This point is considered stable. integer ( int32 ), parameter :: HYPERBOLIC_FIXED_POINT_SOURCE = 101 !! Describes a hyperbolic fixed point where all of the eigenvalues of !! the dynamics matrix have a nonzero real part and the real !! part is positive-valued for each. This point is considered unstable. integer ( int32 ), parameter :: HYPERBOLIC_FIXED_POINT_SADDLE = 102 !! Describes a hyperbolic fixed point where all of the eigenvalues of !! the dynamics matrix have a nonzero real part but one or more of the !! eigenvalues has a positive-valued real part. integer ( int32 ), parameter :: NONHYPERBOLIC_FIXED_POINT_UNSTABLE = 103 !! Describes a nonhyperbolic fixed point where one or more of the !! eigenvalues of the dynamics matrix have a positive-valued real part. integer ( int32 ), parameter :: NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE = 104 !! Describes a nonhyperbolic fixed point where some of the eigenvalues !! of the dynamics matrix have negative real parts and the remaining !! eigenvalues all have zero-valued real parts. integer ( int32 ), parameter :: NONHYPERBOLIC_FIXED_POINT_CENTER = 105 !! Describes a nonhyperbolic fixed point where all of the eigenvalues !! of the dynamics matrix are purely imaginary and nonzero. This point !! is considered stable. contains ! ------------------------------------------------------------------------------ function determine_local_stability ( a , ev , err ) result ( rst ) !! Determines the nature of stability/unstability near the point at which !! the dynamics matrix was computed. real ( real64 ), intent ( in ), dimension (:,:) :: a !! An N-by-N matrix containing the 'A' matrix, also known as the !! dynamics matrix. complex ( real64 ), intent ( out ), optional , dimension (:) :: ev !! An optional N-element array that, if supplied, will be filled with !! the eigenvalues of the matrix A. class ( errors ), intent ( inout ), optional , target :: err !! An error handler object. integer ( int32 ) :: rst !! Describe the output constants ! Local Variables logical :: hyperbolic integer ( int32 ) :: i , n , flag , npositive , nnegative real ( real64 ) :: tol , rv real ( real64 ), allocatable , dimension (:,:) :: acpy complex ( real64 ), allocatable , dimension (:) :: vals class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( a , 1 ) tol = 1.0d1 * epsilon ( tol ) ! zero checking tolerance ! Input Checking if ( size ( a , 2 ) /= n ) then call report_nonsquare_matrix_error ( \"determine_local_stability\" , \"a\" , & size ( a , 1 ), size ( a , 2 ), errmgr ) return end if ! Local Memory Allocation allocate ( acpy ( n , n ), source = a , stat = flag ) if ( flag /= 0 ) go to 10 allocate ( vals ( n ), stat = flag ) if ( flag /= 0 ) go to 10 ! Perform the eigen analysis on A call eigen ( acpy , vals , err = errmgr ) if ( errmgr % has_error_occurred ()) return ! Cycle over each eigenvalue hyperbolic = . true . npositive = 0 nnegative = 0 do i = 1 , n rv = real ( vals ( i ), real64 ) if ( abs ( rv ) < tol ) then ! zero-valued real part - must be nonhyperbolic hyperbolic = . false . else if ( rv > 0.0d0 ) then ! positive-valued real part npositive = npositive + 1 else ! negative-valued real part nnegative = nnegative + 1 end if end do ! Characterize the results if ( hyperbolic ) then if ( nnegative == n ) then rst = HYPERBOLIC_FIXED_POINT_SINK else if ( npositive == n ) then rst = HYPERBOLIC_FIXED_POINT_SOURCE else rst = HYPERBOLIC_FIXED_POINT_SADDLE end if else if ( nnegative == 0 . and . npositive == 0 ) then rst = NONHYPERBOLIC_FIXED_POINT_CENTER else if ( nnegative > 0 . and . npositive == 0 ) then rst = NONHYPERBOLIC_FIXED_POINT_NEUTRALLY_STABLE else rst = NONHYPERBOLIC_FIXED_POINT_UNSTABLE end if end if ! Optional Outputs if ( present ( ev )) then if ( size ( ev ) /= n ) then call report_array_size_error ( \"determine_local_stability\" , \"ev\" , & n , size ( ev ), errmgr ) return end if ev = vals end if ! End return ! Memory Error Handling 10 continue call report_memory_error ( \"determine_local_stability\" , flag , errmgr ) return end function ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_stability.f90.html"},{"title":"dynamics_structural.f90 – DYNAMICS","text":"Contents Modules dynamics_structural Source Code dynamics_structural.f90 Source Code ! Shape Functions: ! 2D Line: https://www.mm.bme.hu/~gyebro/files/ans_help_v182/ans_thry/thy_shp1.html#shp2dlinerdof ! 3D Line: https://www.mm.bme.hu/~gyebro/files/ans_help_v182/ans_thry/thy_shp2.html#shp3d2node module dynamics_structural use iso_fortran_env use linalg , only : csr_matrix , create_csr_matrix , sort use ferror use dynamics_error_handling use dynamics_rotation implicit none private public :: DYN_ONE_POINT_INTEGRATION_RULE public :: DYN_TWO_POINT_INTEGRATION_RULE public :: DYN_THREE_POINT_INTEGRATION_RULE public :: DYN_FOUR_POINT_INTEGRATION_RULE public :: node public :: material public :: element public :: line_element public :: beam_element_2d public :: shape_function_derivative public :: shape_function_second_derivative public :: create_connectivity_matrix public :: apply_boundary_conditions public :: apply_displacement_constraint public :: restore_constrained_values public :: point public :: beam_element_3d ! ****************************************************************************** ! CONSTANTS ! ------------------------------------------------------------------------------ integer ( int32 ), parameter :: DYN_ONE_POINT_INTEGRATION_RULE = 1 !! Defines a single-point integration rule. integer ( int32 ), parameter :: DYN_TWO_POINT_INTEGRATION_RULE = 2 !! Defines a two-point integration rule. integer ( int32 ), parameter :: DYN_THREE_POINT_INTEGRATION_RULE = 3 !! Defines a three-point integration rule. integer ( int32 ), parameter :: DYN_FOUR_POINT_INTEGRATION_RULE = 4 !! Defines a four-point integration rule. ! ****************************************************************************** ! TYPES ! ------------------------------------------------------------------------------ type :: point !! Defines a point in 3D, Cartesian space. real ( real64 ) :: x !! The x-coordinate. real ( real64 ) :: y !! The y-coordinate. real ( real64 ) :: z !! The z-coordinate. end type ! ------------------------------------------------------------------------------ type , extends ( point ) :: node !! Defines a node. integer ( int32 ) :: index !! The global index of the node. integer ( int32 ) :: dof !! The number of degrees of freeedom associated with this node. end type ! ------------------------------------------------------------------------------ type :: material !! Defines a linear-elastic-isotropic material. real ( real64 ) :: density !! The density of the material. real ( real64 ) :: modulus !! The modulus of elasticity of the material. real ( real64 ) :: poissons_ratio !! The Poisson's ratio of the material. end type ! ------------------------------------------------------------------------------ type , abstract :: element !! Defines an element. type ( material ) :: material !! The material. contains procedure ( element_query ), deferred , public , pass :: get_dimensionality procedure ( element_query ), deferred , public , pass :: get_node_count procedure ( element_get_node ), deferred , public , pass :: get_node procedure ( element_query ), deferred , public , pass :: get_dof_per_node procedure ( element_shape_function ), deferred , public , pass :: & evaluate_shape_function procedure ( element_matrix_function ), deferred , public , pass :: & shape_function_matrix procedure ( element_matrix_function ), deferred , public , pass :: & strain_displacement_matrix procedure ( element_const_matrix_function ), deferred , public , & pass :: constitutive_matrix procedure ( element_matrix_function ), deferred , public , pass :: & jacobian procedure , public :: stiffness_matrix => e_stiffness_matrix procedure , public :: mass_matrix => e_mass_matrix procedure , public :: external_force_vector => e_ext_force_vector end type ! ------------------------------------------------------------------------------ type , extends ( element ), abstract :: line_element !! Defines a line element type. real ( real64 ) :: area !! The element cross-sectional area. contains procedure ( line_element_get_terminal ), deferred , public , pass :: & get_terminal_nodes procedure ( line_element_const_matrix_function ), deferred , public , & pass :: rotation_matrix procedure , public :: length => le_length procedure , public :: stiffness_matrix => le_stiffness_matrix procedure , public :: mass_matrix => le_mass_matrix procedure , public :: external_force_vector => le_ext_force_vector end type ! ------------------------------------------------------------------------------ type , extends ( line_element ) :: beam_element_2d !! Defines a two-dimensional Bernoulli-Euler beam element. real ( real64 ) :: moment_of_inertia !! The beam moment of inertia (second moment of area). type ( node ) :: node_1 !! The first node of the element (s = -1). type ( node ) :: node_2 !! The second node of the element (s = 1). contains procedure , public :: get_dimensionality => b2d_dimensionality procedure , public :: get_node_count => b2d_get_node_count procedure , public :: get_dof_per_node => b2d_dof_per_node procedure , public :: get_node => b2d_get_node procedure , public :: get_terminal_nodes => b2d_terminal_nodes procedure , public :: evaluate_shape_function => b2d_shape_function procedure , public :: shape_function_matrix => b2d_shape_function_matrix_2d procedure , public :: strain_displacement_matrix => b2d_strain_disp_matrix_2d procedure , public :: constitutive_matrix => b2d_constitutive_matrix procedure , public :: jacobian => b2d_jacobian procedure , public :: rotation_matrix => b2d_rotation_matrix procedure , public :: stiffness_matrix => b2d_stiffness_matrix procedure , public :: mass_matrix => b2d_mass_matrix end type ! ------------------------------------------------------------------------------ type , extends ( line_element ) :: beam_element_3d !! Defines a three-dimensional Bernoulli-Euler beam element. real ( real64 ) :: Ixx !! The beam moment of inertia about the element x-axis. real ( real64 ) :: Iyy !! The beam moment of inertia about the element y-axis. real ( real64 ) :: Izz !! The beam moment of inertia about the element z-axis. type ( node ) :: node_1 !! The first node of the element (s = -1). type ( node ) :: node_2 !! The second node of the element (s = 1). type ( point ) :: orientation_point !! A point used to determine the orientation of the beam in 3D !! space. The orientation point is measured relative to the first !! node in the element. Specifically, the element z axis is assumed !! to be defined by the location of this point relative to the !! location of node 1. contains procedure , public :: get_dimensionality => b3d_dimensionality procedure , public :: get_node_count => b3d_get_node_count procedure , public :: get_dof_per_node => b3d_dof_per_node procedure , public :: get_node => b3d_get_node procedure , public :: get_terminal_nodes => b3d_terminal_nodes procedure , public :: evaluate_shape_function => b3d_shape_function procedure , public :: shape_function_matrix => b3d_shape_function_matrix_3d procedure , public :: strain_displacement_matrix => b3d_strain_disp_matrix_3d procedure , public :: constitutive_matrix => b3d_constitutive_matrix procedure , public :: jacobian => b3d_jacobian procedure , public :: rotation_matrix => b3d_rotation_matrix procedure , public :: stiffness_matrix => b3d_stiffness_matrix procedure , public :: mass_matrix => b3d_mass_matrix end type ! ****************************************************************************** ! INTERFACES ! ------------------------------------------------------------------------------ interface pure function element_query ( this ) result ( rst ) !! Defines the signature of a function performing a query on an !! integer-valued property of a element type. use iso_fortran_env , only : int32 import element class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ) :: rst !! The resulting value. end function pure function element_get_node ( this , i ) result ( rst ) !! Defines the signature of a function for retrieving the requested !! node from the element. use iso_fortran_env , only : int32 import node import element class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ) :: i !! The local index of the node to retrieve. type ( node ) :: rst !! The node. end function pure function element_matrix_function ( this , s ) result ( rst ) !! Defines the signature of a routine for returning a matrix !! associated with the element. use iso_fortran_env , only : real64 import element class ( element ), intent ( in ) :: this !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinates at which the matrix !! should be evaluated. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. end function pure function element_const_matrix_function ( this ) result ( rst ) !! Defines the signature of a routine for returning a matrix !! associated with the element. use iso_fortran_env , only : real64 import element class ( element ), intent ( in ) :: this !! The element object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. end function pure function element_shape_function ( this , i , s ) result ( rst ) !! Defines the signature of a routine for computing the value of !! the i-th element shape function at natural coordinate. use iso_fortran_env , only : int32 , real64 import element class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ) :: i !! The index of the shape function to evaluate. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinates at which to evaluate !! the shape function. real ( real64 ) :: rst !! The value of the i-th shape function at s. end function pure subroutine line_element_get_terminal ( this , i1 , i2 ) !! Defines the signature of a routine for returning the terminal !! node numbers. use iso_fortran_env , only : int32 import line_element class ( line_element ), intent ( in ) :: this !! The line_element object. integer ( int32 ), intent ( out ) :: i1 !! The index of the node at the head of the element. integer ( int32 ), intent ( out ) :: i2 !! The index of the node at the tail of the element. end subroutine pure function line_element_const_matrix_function ( this ) result ( rst ) !! Defines the signature of a routine for returning a matrix !! associated with the line_element. use iso_fortran_env , only : real64 import line_element class ( line_element ), intent ( in ) :: this !! The line_element object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. end function pure function integrand ( elem , s ) result ( rst ) !! Defines the signature of a function containing an integrand. use iso_fortran_env , only : real64 import element class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The result. end function end interface ! ****************************************************************************** ! OVERLOADED ROUTINES ! ------------------------------------------------------------------------------ interface apply_boundary_conditions module procedure :: apply_boundary_conditions_mtx module procedure :: apply_boundary_conditions_vec end interface contains ! ****************************************************************************** ! DIFFERENTIATION ROUTINES ! ------------------------------------------------------------------------------ pure function shape_function_derivative ( index , elem , s , i ) result ( rst ) !! Computes the derivative of the shape function with respect to the natural !! coordinate specified. integer ( int32 ), intent ( in ) :: index !! The index of the shape function to evaluate. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate at which to evaluate the derivative. integer ( int32 ), intent ( in ) :: i !! The index of the natural coordinate to with which the derivative is !! to be computed. real ( real64 ) :: rst !! The result. ! Local Variables real ( real64 ) :: na , nb , h ( size ( s )) ! Initialization h = 0.0d0 h ( i ) = sqrt ( epsilon ( na )) ! Process na = elem % evaluate_shape_function ( index , s + h ) nb = elem % evaluate_shape_function ( index , s - h ) rst = ( na - nb ) / ( 2.0d0 * h ( i )) end function ! ------------------------------------------------------------------------------ pure function shape_function_second_derivative ( index , elem , s , i ) result ( rst ) !! Computes the second derivative of the shape function with respect to the !! natural coordinate specified. integer ( int32 ), intent ( in ) :: index !! The index of the shape function to evaluate. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate at which to evaluate the derivative. integer ( int32 ), intent ( in ) :: i !! The index of the natural coordinate to with which the derivative is !! to be computed. real ( real64 ) :: rst !! The result. ! Local Variables real ( real64 ) :: na , nb , nc , h ( size ( s )) ! Initialization h = 0.0d0 h ( i ) = ( epsilon ( na )) ** 0.25d0 na = elem % evaluate_shape_function ( index , s + h ) nb = elem % evaluate_shape_function ( index , s ) nc = elem % evaluate_shape_function ( index , s - h ) rst = ( na - 2.0d0 * nb + nc ) / ( h ( i ) ** 2 ) end function ! ****************************************************************************** ! INTEGRATION ! ------------------------------------------------------------------------------ pure function get_model_parameters ( rule ) result ( rst ) !! Gets the requested integration model parameters. integer ( int32 ), intent ( in ) :: rule !! The integration rule. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integration parameters. ! Local Variables real ( real64 ) :: x , w1 , w2 , pt1 , pt2 ! Process select case ( rule ) case ( DYN_ONE_POINT_INTEGRATION_RULE ) allocate ( rst ( 2 , 2 )) rst = reshape ([ 0.0d0 , 0.0d0 , 2.0d0 , 2.0d0 ], [ 2 , 2 ]) case ( DYN_TWO_POINT_INTEGRATION_RULE ) allocate ( rst ( 2 , 2 )) x = sqrt ( 3.0d0 ) / 3.0d0 rst = reshape ([ - x , x , 1.0d0 , 1.0d0 ], [ 2 , 2 ]) case ( DYN_THREE_POINT_INTEGRATION_RULE ) allocate ( rst ( 3 , 2 )) x = sqrt ( 3.0d0 / 5.0d0 ) rst = reshape ([ 0.0d0 , - x , x , w1 , w2 , w2 ], [ 3 , 2 ]) case default ! Four Point Rule allocate ( rst ( 4 , 2 )) pt1 = sqrt (( 3.0d0 / 7.0d0 ) - ( 2.0d0 / 7.0d0 ) * sqrt ( 6.0d0 / 5.0d0 )) pt1 = sqrt (( 3.0d0 / 7.0d0 ) + ( 2.0d0 / 7.0d0 ) * sqrt ( 6.0d0 / 5.0d0 )) w1 = ( 1.8d1 + sqrt ( 3.0d1 )) / 3.6d1 w2 = ( 1.8d1 - sqrt ( 3.0d1 )) / 3.6d1 rst = reshape ([ - pt1 , pt1 , - pt2 , pt2 , w1 , w1 , w2 , w2 ], [ 4 , 2 ]) end select end function ! ------------------------------------------------------------------------------ pure function integrate_1d ( fcn , elem , rule ) result ( rst ) !! Computes the integral of the specified integrand given an element and an !! integration rule. procedure ( integrand ) :: fcn !! The integrand. class ( element ), intent ( in ) :: elem !! The element object. integer ( int32 ), intent ( in ) :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE real ( real64 ), allocatable , dimension (:,:) :: rst !! The result of the integration. ! Local Variables integer ( int32 ) :: i real ( real64 ), allocatable , dimension (:,:) :: s ! Process s = get_model_parameters ( rule ) rst = s ( 1 , 2 ) * fcn ( elem , [ s ( 1 , 1 )]) do i = 2 , size ( s , 1 ) rst = rst + s ( i , 2 ) * fcn ( elem , [ s ( i , 1 )]) end do end function ! ------------------------------------------------------------------------------ pure function integrate ( fcn , elem , rule ) result ( rst ) !! Computes the integral of the specified integrand given an element and an !! integration rule. procedure ( integrand ) :: fcn !! The integrand. class ( element ), intent ( in ) :: elem !! The element object. integer ( int32 ), intent ( in ) :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE real ( real64 ), allocatable , dimension (:,:) :: rst !! The result of the integration. ! Process select type ( elem ) class is ( line_element ) rst = integrate_1d ( fcn , elem , rule ) end select end function ! ****************************************************************************** ! ASSEMBLY ROUTINES ! ------------------------------------------------------------------------------ pure function find_global_dof ( n , nodes ) result ( rst ) !! Finds the index of the global DOF node in a list of nodes. class ( node ), intent ( in ) :: n !! The node for which to search. class ( node ), intent ( in ), dimension (:) :: nodes !! The list of nodes integer ( int32 ) :: rst !! The requested index. ! Local Variables integer ( int32 ) :: i ! Process rst = 0 do i = 1 , size ( nodes ) if ( n % index == nodes ( i )% index ) then rst = rst + 1 exit end if rst = rst + nodes ( i )% dof end do end function ! ------------------------------------------------------------------------------ function create_connectivity_matrix ( gdof , e , nodes , err ) result ( rst ) !! Creates a connectivity matrix for the element. integer ( int32 ), intent ( in ) :: gdof !! The number of global degrees of freedom. class ( element ), intent ( in ) :: e !! The element. class ( node ), intent ( in ), dimension (:) :: nodes !! The global node list. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables integer ( int32 ) :: i , j , col , nnodes , nnz , row , flag class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if nnodes = e % get_node_count () nnz = e % get_dof_per_node () * nnodes allocate ( rst ( nnz , gdof ), source = 0.0d0 , stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"create_connectivity_matrix\" , flag , errmgr ) return end if ! Process row = 0 do j = 1 , nnodes col = find_global_dof ( e % get_node ( j ), nodes ) do i = 1 , e % get_dof_per_node () row = row + 1 rst ( row , col ) = 1.0d0 col = col + 1 end do end do end function ! ------------------------------------------------------------------------------ function apply_boundary_conditions_mtx ( gdof , x , err ) result ( rst ) !! Applies boundary conditions to a matrix by removal of the appropriate !! rows and columns. integer ( int32 ), intent ( inout ), dimension (:) :: gdof !! An array of the global degrees of freedom to restrain. The array !! is sorted into ascending order on output. real ( real64 ), intent ( in ), dimension (:,:) :: x !! The matrix to constrain. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The altered matrix. ! Local Variables integer ( int32 ) :: i , j , ii , m , n , nbc , mnew , flag integer ( int32 ), allocatable , dimension (:) :: indices class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if m = size ( x , 1 ) n = size ( x , 2 ) nbc = size ( gdof ) mnew = m - nbc ! Input Checking if ( m /= n ) then call report_nonsquare_matrix_error ( \"apply_boundary_conditions_mtx\" , & \"x\" , m , n , errmgr ) return end if if ( mnew < 1 ) then call report_overconstraint_error ( \"apply_boundary_conditions_mtx\" , & errmgr ) return end if do i = 1 , nbc if ( gdof ( i ) < 1 . or . gdof ( i ) > m ) then call report_array_index_out_of_bounds_error ( & \"apply_boundary_conditions_mtx\" , \"gdof\" , gdof ( i ), m , errmgr ) return end if end do ! Memory Allocation allocate ( rst ( mnew , mnew ), stat = flag ) if ( flag == 0 ) allocate ( indices ( m - nbc ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"apply_boundary_conditions_mtx\" , flag , errmgr ) return end if ! Sort gdof into ascending order call sort ( gdof , . true .) ! Check for duplicate values in GDOF do i = 2 , nbc if ( gdof ( i ) == gdof ( i - 1 )) then call report_nonmonotonic_array_error (& \"apply_boundary_conditions_mtx\" , \"gdof\" , i , errmgr ) return end if end do ! Process ii = 1 j = 0 do i = 1 , m if ( gdof ( ii ) /= i ) then j = j + 1 indices ( j ) = i else ii = ii + 1 if ( ii > nbc ) ii = nbc end if end do ! Now, we only need store the rows and columns stored in indices rst = x ( indices , indices ) end function ! ------------------------------------------------------------------------------ function apply_boundary_conditions_vec ( gdof , x , err ) result ( rst ) !! Applies boundary conditions to a vector by removal of the appropriate !! items. integer ( int32 ), intent ( inout ), dimension (:) :: gdof !! An array of the global degrees of freedom to restrain. The array !! is sorted into ascending order on output. real ( real64 ), intent ( in ), dimension (:) :: x !! The vector to constrain. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:) :: rst !! The altered vector. ! Local Variables integer ( int32 ) :: i , j , ii , n , nbc , nnew , flag integer ( int32 ), allocatable , dimension (:) :: indices class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( x ) nbc = size ( gdof ) nnew = n - nbc ! Input Checking if ( nnew < 1 ) then call report_overconstraint_error ( \"apply_boundary_conditions_vec\" , & errmgr ) return end if do i = 1 , nbc if ( gdof ( i ) < 1 . or . gdof ( i ) > n ) then call report_array_index_out_of_bounds_error ( & \"apply_boundary_conditions_vec\" , \"gdof\" , gdof ( i ), n , errmgr ) return end if end do ! Memory Allocation allocate ( rst ( nnew ), stat = flag ) if ( flag == 0 ) allocate ( indices ( n - nbc ), stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"apply_boundary_conditions_vec\" , flag , errmgr ) return end if ! Sort gdof into ascending order call sort ( gdof , . true .) ! Check for duplicate values in GDOF do i = 2 , nbc if ( gdof ( i ) == gdof ( i - 1 )) then call report_nonmonotonic_array_error ( & \"apply_boundary_conditions_vec\" , \"gdof\" , i , errmgr ) return end if end do ! Process ii = 1 j = 0 do i = 1 , n if ( gdof ( ii ) /= i ) then j = j + 1 indices ( j ) = i else ii = ii + 1 if ( ii > nbc ) ii = nbc end if end do ! Now, just store the appropriate items in the output vector rst = x ( indices ) end function ! ------------------------------------------------------------------------------ function restore_constrained_values ( gdof , x , err ) result ( rst ) !! Restores the constrained degrees-of-freedom from the boundary conditions !! applied by apply_boundary_conditions. integer ( int32 ), intent ( inout ), dimension (:) :: gdof !! An array of the global degrees of freedom to restrain. The array !! is sorted into ascending order on output. real ( real64 ), intent ( in ), dimension (:) :: x !! The constrained vector. class ( errors ), intent ( inout ), optional , target :: err !! An optional error handling object. real ( real64 ), allocatable , dimension (:) :: rst !! The altered vector. ! Local Variables integer ( int32 ) :: i , j , ii , n , nbc , nnew , flag class ( errors ), pointer :: errmgr type ( errors ), target :: deferr ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if n = size ( x ) nbc = size ( gdof ) nnew = n + nbc ! Input Checking do i = 1 , nbc if ( gdof ( i ) < 1 . or . gdof ( i ) > nnew ) then call report_array_index_out_of_bounds_error ( & \"restore_constrained_values\" , \"gdof\" , gdof ( i ), nnew , errmgr ) return end if end do ! Memory Allocation allocate ( rst ( nnew ), source = 0.0d0 , stat = flag ) if ( flag /= 0 ) then call report_memory_error ( \"restore_constrained_values\" , flag , errmgr ) return end if ! Sort gdof into ascending order call sort ( gdof , . true .) ! Check for duplicate values in GDOF do i = 2 , nbc if ( gdof ( i ) == gdof ( i - 1 )) then call report_nonmonotonic_array_error ( & \"restore_constrained_values\" , \"gdof\" , i , errmgr ) return end if end do ! Process ii = 1 j = 0 do i = 1 , nnew if ( i == gdof ( ii )) then ii = ii + 1 if ( ii > nbc ) ii = nbc else j = j + 1 rst ( i ) = x ( j ) end if end do end function ! ------------------------------------------------------------------------------ ! REF: https://www.sciencedirect.com/topics/engineering/prescribed-displacement-boundary-condition subroutine apply_displacement_constraint ( dof , val , k , f ) !! Applies a displacement constraint to the specified degree of freedom. integer ( int32 ), intent ( in ) :: dof !! The global degree-of-freedom to which the constraint should be !! applied. real ( real64 ), intent ( in ) :: val !! The value of the displacement constraint. real ( real64 ), intent ( inout ), dimension (:,:) :: k !! The stiffness matrix to which the constraint should be applied. real ( real64 ), intent ( inout ), dimension (:) :: f !! The external force vector to which the constraint should be applied. ! Wipe out the rows in the matrix and place a value of 1 on the diagonal k ( dof ,:) = 0.0d0 k ( dof , dof ) = 1.0d0 ! Update the external force vector f ( dof ) = val end subroutine ! ****************************************************************************** ! ELEMENT MEMBERS ! ------------------------------------------------------------------------------ pure function e_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables integer ( int32 ) :: r ! Initialization if ( present ( rule )) then r = rule else r = DYN_TWO_POINT_INTEGRATION_RULE end if ! Process rst = integrate ( element_stiffness_integrand , this , r ) end function ! ---------- pure function element_stiffness_integrand ( elem , s ) result ( rst ) !! The integrand function for computing the stiffness matrix of an element. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate vector at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integrand. ! Local Variables real ( real64 ) :: jdet real ( real64 ), allocatable , dimension (:,:) :: b , bt , d , x , jac ! Process b = elem % strain_displacement_matrix ( s ) bt = transpose ( b ) d = elem % constitutive_matrix () jac = elem % jacobian ( s ) jdet = det ( jac ) x = matmul ( d , b ) rst = jdet * matmul ( bt , x ) end function ! ------------------------------------------------------------------------------ pure function e_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( element ), intent ( in ) :: this !! The element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables integer ( int32 ) :: r ! Initialization if ( present ( rule )) then r = rule else r = DYN_TWO_POINT_INTEGRATION_RULE end if ! Process rst = integrate ( element_mass_integrand , this , r ) end function ! ---------- pure function element_mass_integrand ( elem , s ) result ( rst ) !! The integrand function for computing the mass matrix of an element. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate vector at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integrand. ! Local Variables real ( real64 ) :: jdet real ( real64 ), allocatable , dimension (:,:) :: N , Nt , jac ! Process N = elem % shape_function_matrix ( s ) Nt = transpose ( N ) jac = elem % jacobian ( s ) jdet = det ( jac ) rst = elem % material % density * jdet * matmul ( Nt , N ) end function ! ------------------------------------------------------------------------------ pure function e_ext_force_vector ( this , q , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( element ), intent ( in ) :: this !! The element object. real ( real64 ), intent ( in ), dimension (:) :: q !! The surface traction forces vector or body force vector. !! For instance, a 2D problem this vector would look like [qx, qy]**T. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:) :: rst !! The resulting vector. ! Local Variables integer ( int32 ) :: r ! Initialization if ( present ( rule )) then r = rule else r = DYN_TWO_POINT_INTEGRATION_RULE end if ! Process rst = matmul ( & integrate ( element_ext_force_integrand , this , r ), & q & ) end function ! ---------- pure function element_ext_force_integrand ( elem , s ) result ( rst ) !! The integrand function for computing the external force vector of an !! element. class ( element ), intent ( in ) :: elem !! The element object. real ( real64 ), intent ( in ), dimension (:) :: s !! The natural coordinate vector at which to evaluate the integrand. real ( real64 ), allocatable , dimension (:,:) :: rst !! The integrand. ! Local Variables real ( real64 ) :: jdet real ( real64 ), allocatable , dimension (:,:) :: Nt , jac ! Process Nt = transpose ( elem % shape_function_matrix ( s )) jac = elem % jacobian ( s ) jdet = det ( jac ) rst = jdet * Nt end function ! ****************************************************************************** ! LINE_ELEMENT MEMBERS ! ------------------------------------------------------------------------------ pure function le_length ( this ) result ( rst ) !! Computes the length of the line_element. class ( line_element ), intent ( in ) :: this !! The line_element object. real ( real64 ) :: rst !! The length of the line element. ! Local Variables real ( real64 ) :: dx , dy , dz integer ( int32 ) :: i1 , i2 type ( node ) :: n1 , n2 ! Process call this % get_terminal_nodes ( i1 , i2 ) n1 = this % get_node ( i1 ) n2 = this % get_node ( i2 ) dx = n2 % x - n1 % x dy = n2 % y - n1 % y dz = n2 % z - n1 % z rst = sqrt ( dx ** 2 + dy ** 2 + dz ** 2 ) end function ! ------------------------------------------------------------------------------ pure function le_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( line_element ), intent ( in ) :: this !! The line_element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Compute the stiffness matrix and apply the rotation transformation rst = e_stiffness_matrix ( this , rule ) rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function le_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( line_element ), intent ( in ) :: this !! The line_element object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Compute the mass matrix and apply the rotation transformation rst = e_mass_matrix ( this , rule ) rst = this % area * matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function le_ext_force_vector ( this , q , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( line_element ), intent ( in ) :: this !! The line_element object. real ( real64 ), intent ( in ), dimension (:) :: q !! The surface traction forces vector or body force vector. !! For instance, a 2D problem this vector would look like [qx, qy]**T. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - DYN_ONE_POINT_INTEGRATION_RULE !! !! - DYN_TWO_POINT_INTEGRATION_RULE !! !! - DYN_THREE_POINT_INTEGRATION_RULE !! !! - DYN_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is DYN_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:) :: rst !! The resulting vector. ! Local Variables real ( real64 ), allocatable , dimension (:,:) :: T ! Compute the rotation matrix T = this % rotation_matrix () ! Compute the force vector rst = e_ext_force_vector ( this , q , rule ) rst = matmul ( T , rst ) end function ! ****************************************************************************** ! BEAM_2D ROUTINES ! ------------------------------------------------------------------------------ pure function b2d_dimensionality ( this ) result ( rst ) !! Gets the dimensionality of the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ) :: rst !! The dimensionality. rst = 2 end function ! ------------------------------------------------------------------------------ pure function b2d_get_node_count ( this ) result ( rst ) !! Gets the number of nodes for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ) :: rst !! The number of nodes. rst = 2 end function ! ------------------------------------------------------------------------------ pure function b2d_dof_per_node ( this ) result ( rst ) !! Gets the number of degrees of freedom per node. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ) :: rst !! The number of DOF per node. rst = 3 end function ! ------------------------------------------------------------------------------ pure function b2d_get_node ( this , i ) result ( rst ) !! Gets the requested node from the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ) :: i !! The local index of the node to retrieve. type ( node ) :: rst !! The requested node. if ( i == 1 ) then rst = this % node_1 else rst = this % node_2 end if end function ! ------------------------------------------------------------------------------ pure subroutine b2d_terminal_nodes ( this , i1 , i2 ) !! Gets the terminal node numbers for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( out ) :: i1 !! The index of the node at the head of the element. integer ( int32 ), intent ( out ) :: i2 !! The index of the node at the tail of the element. i1 = 1 i2 = 2 end subroutine ! ------------------------------------------------------------------------------ pure function b2d_shape_function ( this , i , s ) result ( rst ) !! Evaluates the i-th shape function at natural coordinate s. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ) :: i !! The index of the shape function to evaluate. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate !! the shape function. real ( real64 ) :: rst !! The value of the i-th shape function at s. ! Local Variables real ( real64 ) :: l ! Process select case ( i ) case ( 1 ) rst = 0.5d0 * ( 1.0d0 - s ( 1 )) case ( 2 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 2.0d0 + s ( 1 )) case ( 3 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 1.0d0 + s ( 1 )) case ( 4 ) rst = 0.5d0 * ( 1.0d0 + s ( 1 )) case ( 5 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( 2.0d0 - s ( 1 )) case ( 6 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( s ( 1 ) - 1.0d0 ) case default rst = 0.0d0 end select end function ! ------------------------------------------------------------------------------ pure function b2d_shape_function_matrix_2d ( this , s ) result ( rst ) !! Computes the shape function matrix for a beam element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the shape !! functions. real ( real64 ), allocatable , dimension (:,:) :: rst !! The shape function matrix. ! Local Variables real ( real64 ) :: n1 , n2 , n3 , n4 , n5 , n6 , l ! Initialization allocate ( rst ( 2 , 6 ), source = 0.0d0 ) l = this % length () ! Process n1 = this % evaluate_shape_function ( 1 , s ) n2 = this % evaluate_shape_function ( 2 , s ) n3 = 0.5d0 * l * this % evaluate_shape_function ( 3 , s ) n4 = this % evaluate_shape_function ( 4 , s ) n5 = this % evaluate_shape_function ( 5 , s ) n6 = 0.5d0 * l * this % evaluate_shape_function ( 6 , s ) rst ( 1 , 1 ) = n1 rst ( 2 , 2 ) = n2 rst ( 2 , 3 ) = n3 rst ( 1 , 4 ) = n4 rst ( 2 , 5 ) = n5 rst ( 2 , 6 ) = n6 end function ! ------------------------------------------------------------------------------ pure function b2d_strain_disp_matrix_2d ( this , s ) result ( rst ) !! Computes the strain-displacement matrix for a 2D beam element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The strain-displacement matrix. ! Local Variables real ( real64 ) :: l , dsdx , dn1ds , dn2ds , dn3ds , dn4ds , dn5ds , dn6ds ! Initialization allocate ( rst ( 2 , 6 ), source = 0.0d0 ) ! Process l = this % length () dsdx = 2.0d0 / l ! s = 2 * x / L - 1, so ds/dx = 2 / L dn1ds = shape_function_derivative ( 1 , this , s , 1 ) dn2ds = shape_function_second_derivative ( 2 , this , s , 1 ) dn3ds = shape_function_second_derivative ( 3 , this , s , 1 ) dn4ds = shape_function_derivative ( 4 , this , s , 1 ) dn5ds = shape_function_second_derivative ( 5 , this , s , 1 ) dn6ds = shape_function_second_derivative ( 6 , this , s , 1 ) rst ( 1 , 1 ) = dn1ds * dsdx rst ( 2 , 2 ) = dn2ds * dsdx ** 2 rst ( 2 , 3 ) = 0.5d0 * l * dn3ds * dsdx ** 2 rst ( 1 , 4 ) = dn4ds * dsdx rst ( 2 , 5 ) = dn5ds * dsdx ** 2 rst ( 2 , 6 ) = 0.5d0 * l * dn6ds * dsdx ** 2 end function ! ------------------------------------------------------------------------------ pure function b2d_constitutive_matrix ( this ) result ( rst ) !! Computes the constitutive matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Process allocate ( rst ( 2 , 2 ), source = 0.0d0 ) rst ( 1 , 1 ) = this % area * this % material % modulus rst ( 2 , 2 ) = this % moment_of_inertia * this % material % modulus end function ! ------------------------------------------------------------------------------ pure function b2d_jacobian ( this , s ) result ( rst ) !! Computes the Jacobian matrix for a 2D beam element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The Jacobian matrix. rst = reshape ([ 0.5d0 * this % length ()], [ 1 , 1 ]) end function ! ------------------------------------------------------------------------------ pure function b2d_rotation_matrix ( this ) result ( rst ) !! Computes the rotation matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 6-by-6 rotation matrix. ! Local Variables real ( real64 ) :: theta , ct , st type ( node ) :: n1 , n2 ! Process allocate ( rst ( 6 , 6 ), source = 0.0d0 ) n1 = this % get_node ( 1 ) n2 = this % get_node ( 2 ) theta = atan2 ( n2 % y - n1 % y , n2 % x - n1 % x ) ct = cos ( theta ) st = sin ( theta ) rst ( 1 , 1 ) = ct rst ( 2 , 1 ) = st rst ( 1 , 2 ) = - st rst ( 2 , 2 ) = ct rst ( 3 , 3 ) = 1.0d0 rst ( 4 , 4 ) = ct rst ( 5 , 4 ) = st rst ( 4 , 5 ) = - st rst ( 5 , 5 ) = ct rst ( 6 , 6 ) = 1.0d0 end function ! ------------------------------------------------------------------------------ pure function b2d_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: A , E , I , L real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization A = this % area E = this % material % modulus I = this % moment_of_inertia L = this % length () ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Construct the stiffness matrix allocate ( rst ( 6 , 6 ), source = 0.0d0 ) rst ( 1 , 1 ) = A * E / L rst ( 2 , 2 ) = 1 2.0d0 * E * I / ( L ** 3 ) rst ( 3 , 3 ) = 4.0d0 * E * I / L rst ( 2 , 3 ) = 6.0d0 * E * I / ( L ** 2 ) rst ( 3 , 2 ) = rst ( 2 , 3 ) rst ( 1 , 4 ) = - rst ( 1 , 1 ) rst ( 4 , 1 ) = rst ( 1 , 4 ) rst ( 2 , 5 ) = - rst ( 2 , 2 ) rst ( 5 , 2 ) = rst ( 2 , 5 ) rst ( 2 , 6 ) = rst ( 2 , 3 ) rst ( 6 , 2 ) = rst ( 2 , 6 ) rst ( 3 , 5 ) = - rst ( 2 , 3 ) rst ( 5 , 3 ) = rst ( 3 , 5 ) rst ( 3 , 6 ) = 2.0d0 * E * I / L rst ( 6 , 3 ) = rst ( 3 , 6 ) rst ( 4 : 6 , 4 : 6 ) = rst ( 1 : 3 , 1 : 3 ) rst ( 5 , 6 ) = - rst ( 2 , 3 ) rst ( 6 , 5 ) = rst ( 5 , 6 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function b2d_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( beam_element_2d ), intent ( in ) :: this !! The beam_element_2d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: rho , A , L , f real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization rho = this % material % density A = this % area L = this % length () f = rho * A * L / 4.2d2 ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Construct the mass matrix allocate ( rst ( 6 , 6 ), source = 0.0d0 ) rst ( 1 , 1 ) = 1.4d2 * f rst ( 4 , 1 ) = 7.0d1 * f rst ( 2 , 2 ) = 1.56d2 * f rst ( 3 , 2 ) = 2.2d1 * L * f rst ( 5 , 2 ) = 5.4d1 * f rst ( 6 , 2 ) = - 1.3d1 * L * f rst ( 2 , 3 ) = rst ( 3 , 2 ) rst ( 3 , 3 ) = 4.0d0 * L ** 2 * f rst ( 5 , 3 ) = 1.3d1 * L * f rst ( 6 , 3 ) = - 3.0d0 * L ** 2 * f rst ( 1 , 4 ) = rst ( 4 , 1 ) rst ( 4 , 4 ) = rst ( 1 , 1 ) rst ( 2 , 5 ) = rst ( 5 , 2 ) rst ( 3 , 5 ) = rst ( 5 , 3 ) rst ( 5 , 5 ) = rst ( 2 , 2 ) rst ( 6 , 5 ) = - 2.2d1 * L * f rst ( 2 , 6 ) = rst ( 6 , 2 ) rst ( 3 , 6 ) = rst ( 6 , 3 ) rst ( 5 , 6 ) = rst ( 6 , 5 ) rst ( 6 , 6 ) = rst ( 3 , 3 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ****************************************************************************** ! PRIVATE ROUTINES ! ------------------------------------------------------------------------------ pure function det_1 ( x ) result ( rst ) ! Determinant of a 1-by-1 matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x real ( real64 ) :: rst rst = x ( 1 , 1 ) end function ! ------------------------------------------------------------------------------ pure function det_2 ( x ) result ( rst ) ! Determinant of a 2-by-2 matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x real ( real64 ) :: rst rst = x ( 1 , 1 ) * x ( 2 , 2 ) - x ( 1 , 2 ) * x ( 2 , 1 ) end function ! ------------------------------------------------------------------------------ pure function det_3 ( x ) result ( rst ) ! Determinant of a 3-by-3 matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x real ( real64 ) :: rst rst = x ( 1 , 1 ) * ( x ( 2 , 2 ) * x ( 3 , 3 ) - x ( 2 , 3 ) * x ( 3 , 2 )) - & x ( 1 , 2 ) * ( x ( 2 , 1 ) * x ( 3 , 3 ) - x ( 2 , 3 ) * x ( 3 , 1 )) + & x ( 1 , 3 ) * ( x ( 2 , 1 ) * x ( 3 , 2 ) - x ( 2 , 2 ) * x ( 3 , 1 )) end function ! ------------------------------------------------------------------------------ pure function det ( x ) result ( rst ) !! Computes the determinant of a matrix. real ( real64 ), intent ( in ), dimension (:,:) :: x !! The matrix on which to operate. real ( real64 ) :: rst !! The determinant. select case ( size ( x , 1 )) case ( 1 ) rst = det_1 ( x ) case ( 2 ) rst = det_2 ( x ) case ( 3 ) rst = det_3 ( x ) case default rst = 0.0d0 end select end function ! ------------------------------------------------------------------------------ ! REF: https://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line pure function normal_vector_to_line ( pt1 , pt2 , pt ) result ( rst ) !! Computes the normal vector to a line defined by pt1 and pt2 assuming !! some point (pt) not on the line. class ( point ), intent ( in ) :: pt1 !! The origin point of the line segment. class ( point ), intent ( in ) :: pt2 !! The termination point of the line segment. class ( point ), intent ( in ) :: pt !! A point, not on the line. real ( real64 ) :: rst ( 3 ) !! The resulting normal vector (unit length). ! Local Variables real ( real64 ) :: a ( 3 ), p ( 3 ), n ( 3 ), amp ( 3 ) ! Initialization a = [ pt1 % x , pt1 % y , pt1 % z ] n = [ pt2 % x , pt2 % y , pt2 % z ] - a p = [ pt % x , pt % y , pt % z ] amp = a - p rst = amp - dot_product ( amp , n ) * n rst = rst / norm2 ( rst ) end function ! ****************************************************************************** ! BEAM_3D ROUTINES ! ------------------------------------------------------------------------------ pure function b3d_dimensionality ( this ) result ( rst ) !! Gets the dimensionality of the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ) :: rst !! The dimensionality. rst = 3 end function ! ------------------------------------------------------------------------------ pure function b3d_get_node_count ( this ) result ( rst ) !! Gets the number of nodes for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ) :: rst !! The number of nodes. rst = 2 end function ! ------------------------------------------------------------------------------ pure function b3d_dof_per_node ( this ) result ( rst ) !! Gets the number of degrees of freedom per node. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ) :: rst !! The number of DOF per node. rst = 6 end function ! ------------------------------------------------------------------------------ pure function b3d_get_node ( this , i ) result ( rst ) !! Gets the requested node from the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ) :: i !! The local index of the node to retrieve. type ( node ) :: rst !! The requested node. if ( i == 1 ) then rst = this % node_1 else rst = this % node_2 end if end function ! ------------------------------------------------------------------------------ pure subroutine b3d_terminal_nodes ( this , i1 , i2 ) !! Gets the terminal node numbers for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( out ) :: i1 !! The index of the node at the head of the element. integer ( int32 ), intent ( out ) :: i2 !! The index of the node at the tail of the element. i1 = 1 i2 = 2 end subroutine ! ------------------------------------------------------------------------------ pure function b3d_shape_function ( this , i , s ) result ( rst ) !! Evaluates the i-th shape function at natural coordinate s. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ) :: i !! The index of the shape function to evaluate. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate !! the shape function. real ( real64 ) :: rst !! The value of the i-th shape function at s. ! Local Variables real ( real64 ) :: l ! Process select case ( i ) case ( 1 ) rst = 0.5d0 * ( 1.0d0 - s ( 1 )) case ( 2 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 2.0d0 + s ( 1 )) case ( 3 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 )) ** 2 * ( 2.0d0 + s ( 1 )) case ( 4 ) rst = 0.5d0 * ( 1.0d0 - s ( 1 )) case ( 5 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 - s ( 1 )) case ( 6 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 - s ( 1 )) case ( 7 ) rst = 0.5d0 * ( 1.0d0 + s ( 1 )) case ( 8 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( 2.0d0 - s ( 1 )) case ( 9 ) rst = 0.25d0 * ( 1.0d0 + s ( 1 )) ** 2 * ( 2.0d0 - s ( 1 )) case ( 10 ) rst = 0.5d0 * ( 1.0d0 + s ( 1 )) case ( 11 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 + s ( 1 )) case ( 12 ) rst = 0.25d0 * ( 1.0d0 - s ( 1 ) ** 2 ) * ( 1.0d0 + s ( 1 )) case default rst = 0.0d0 end select end function ! ------------------------------------------------------------------------------ pure function b3d_shape_function_matrix_3d ( this , s ) result ( rst ) !! Computes the shape function matrix for a beam element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the shape !! functions. real ( real64 ), allocatable , dimension (:,:) :: rst !! The shape function matrix. ! Local Variables real ( real64 ) :: n1 , n2 , n3 , n4 , n5 , n6 , n7 , n8 , n9 , n10 , n11 , n12 , l ! Initialization allocate ( rst ( 4 , 12 ), source = 0.0d0 ) l = this % length () ! Process n1 = this % evaluate_shape_function ( 1 , s ) n2 = this % evaluate_shape_function ( 2 , s ) n3 = this % evaluate_shape_function ( 3 , s ) n4 = this % evaluate_shape_function ( 4 , s ) n5 = - 0.5d0 * l * this % evaluate_shape_function ( 5 , s ) n6 = 0.5d0 * l * this % evaluate_shape_function ( 6 , s ) n7 = this % evaluate_shape_function ( 7 , s ) n8 = this % evaluate_shape_function ( 8 , s ) n9 = this % evaluate_shape_function ( 9 , s ) n10 = this % evaluate_shape_function ( 10 , s ) n11 = 0.5d0 * l * this % evaluate_shape_function ( 11 , s ) n12 = - 0.5d0 * l * this % evaluate_shape_function ( 12 , s ) rst ( 1 , 1 ) = n1 rst ( 2 , 2 ) = n2 rst ( 3 , 3 ) = n3 rst ( 4 , 4 ) = n4 rst ( 3 , 5 ) = n5 rst ( 2 , 6 ) = n6 rst ( 1 , 7 ) = n7 rst ( 2 , 8 ) = n8 rst ( 3 , 9 ) = n9 rst ( 4 , 10 ) = n10 rst ( 3 , 11 ) = n11 rst ( 2 , 12 ) = n12 end function ! ------------------------------------------------------------------------------ pure function b3d_strain_disp_matrix_3d ( this , s ) result ( rst ) !! Computes the strain-displacement matrix for a 3D beam element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The strain-displacement matrix. ! Local Variables real ( real64 ) :: l , dsdx , dn1ds , dn2ds , dn3ds , dn4ds , dn5ds , dn6ds , & dn7ds , dn8ds , dn9ds , dn10ds , dn11ds , dn12ds ! Initialization allocate ( rst ( 4 , 12 ), source = 0.0d0 ) ! Process l = this % length () dsdx = 2.0d0 / l ! s = 2 * x / L - 1, so ds/dx = 2 / L dn1ds = shape_function_derivative ( 1 , this , s , 1 ) dn2ds = shape_function_second_derivative ( 2 , this , s , 1 ) dn3ds = shape_function_second_derivative ( 3 , this , s , 1 ) dn4ds = shape_function_derivative ( 4 , this , s , 1 ) dn5ds = - 0.5d0 * l * shape_function_second_derivative ( 5 , this , s , 1 ) dn6ds = 0.5d0 * l * shape_function_second_derivative ( 6 , this , s , 1 ) dn7ds = shape_function_derivative ( 7 , this , s , 1 ) dn8ds = shape_function_second_derivative ( 8 , this , s , 1 ) dn9ds = shape_function_second_derivative ( 9 , this , s , 1 ) dn10ds = shape_function_derivative ( 10 , this , s , 1 ) dn11ds = 0.5d0 * l * shape_function_second_derivative ( 11 , this , s , 1 ) dn12ds = - 0.5d0 * l * shape_function_second_derivative ( 12 , this , s , 1 ) ! Build the matrix rst ( 1 , 1 ) = dn1ds * dsdx rst ( 2 , 2 ) = dn2ds * dsdx ** 2 rst ( 3 , 3 ) = dn3ds * dsdx ** 2 rst ( 4 , 4 ) = dn4ds * dsdx rst ( 3 , 5 ) = dn5ds * dsdx ** 2 rst ( 2 , 6 ) = dn6ds * dsdx ** 2 rst ( 1 , 7 ) = dn7ds * dsdx rst ( 2 , 8 ) = dn8ds * dsdx ** 2 rst ( 3 , 9 ) = dn9ds * dsdx ** 2 rst ( 4 , 10 ) = dn10ds * dsdx rst ( 3 , 11 ) = dn11ds * dsdx ** 2 rst ( 2 , 12 ) = dn12ds * dsdx ** 2 end function ! ------------------------------------------------------------------------------ pure function b3d_constitutive_matrix ( this ) result ( rst ) !! Computes the constitutive matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Process allocate ( rst ( 4 , 4 ), source = 0.0d0 ) rst ( 1 , 1 ) = this % area * this % material % modulus rst ( 2 , 2 ) = this % Izz * this % material % modulus rst ( 3 , 3 ) = this % Iyy * this % material % modulus rst ( 4 , 4 ) = this % Ixx * this % material % modulus / & ( 2.0d0 * ( 1.0d0 + this % material % poissons_ratio )) end function ! ------------------------------------------------------------------------------ pure function b3d_jacobian ( this , s ) result ( rst ) !! Computes the Jacobian matrix for a 3D beam element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), intent ( in ), dimension (:) :: s !! The value of the natural coordinate at which to evaluate the matrix. real ( real64 ), allocatable , dimension (:,:) :: rst !! The Jacobian matrix. rst = reshape ([ 0.5d0 * this % length ()], [ 1 , 1 ]) end function ! ------------------------------------------------------------------------------ pure function b3d_rotation_matrix ( this ) result ( rst ) !! Computes the rotation matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting 12-by-12 rotation matrix. ! Local Variables real ( real64 ) :: i ( 3 ), j ( 3 ), k ( 3 ) ! Define the unit vectors i = [ & this % node_2 % x - this % node_1 % x , & this % node_2 % y - this % node_1 % y , & this % node_2 % z - this % node_1 % z & ] i = i / norm2 ( i ) k = normal_vector_to_line ( this % node_1 , this % node_2 , this % orientation_point ) j = [ & k ( 2 ) * i ( 3 ) - k ( 3 ) * i ( 2 ), & k ( 3 ) * i ( 1 ) - k ( 1 ) * i ( 3 ), & k ( 1 ) * i ( 2 ) - k ( 2 ) * i ( 1 ) & ] ! Construct the matrix allocate ( rst ( 12 , 12 ), source = 0.0d0 ) rst ( 1 : 3 , 1 : 3 ) = rotate ( i , j , k ) rst ( 4 : 6 , 4 : 6 ) = rst ( 1 : 3 , 1 : 3 ) rst ( 7 : 9 , 7 : 9 ) = rst ( 1 : 3 , 1 : 3 ) rst ( 10 : 12 , 10 : 12 ) = rst ( 1 : 3 , 1 : 3 ) end function ! ------------------------------------------------------------------------------ ! https://www.researchgate.net/publication/352816965_3-D_Beam_Finite_Element_Programming_-A_Practical_Guide_Part_1 ! https://homes.civil.aau.dk/jc/FemteSemester/Beams3D.pdf ! https://www.sesamx.io/blog/beam_finite_element/ ! https://www.brown.edu/Departments/Engineering/Courses/En2340/Projects/Projects_2015/Wenqiang_Fan.pdf ! https://www.mm.bme.hu/~gyebro/files/ans_help_v182/ans_thry/thy_shp2.html#shp3d2node pure function b3d_stiffness_matrix ( this , rule ) result ( rst ) !! Computes the stiffness matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: A , E , Iyy , Izz , Jxx , G , L real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization A = this % area Jxx = this % Ixx Iyy = this % Iyy Izz = this % Izz E = this % material % modulus G = E / ( 2.0d0 * ( 1.0d0 + this % material % poissons_ratio )) L = this % length () ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Construct the stiffness matrix allocate ( rst ( 12 , 12 ), source = 0.0d0 ) rst ( 1 , 1 ) = A * E / L rst ( 7 , 1 ) = - rst ( 1 , 1 ) rst ( 2 , 2 ) = 1.2d1 * E * Izz / L ** 3 rst ( 6 , 2 ) = 6.0d0 * E * Izz / L ** 2 rst ( 8 , 2 ) = - rst ( 2 , 2 ) rst ( 12 , 2 ) = rst ( 6 , 2 ) rst ( 3 , 3 ) = 1.2d1 * E * Iyy / L ** 3 rst ( 5 , 3 ) = - 6.0d0 * E * Iyy / L ** 2 rst ( 9 , 3 ) = - rst ( 3 , 3 ) rst ( 11 , 3 ) = rst ( 5 , 3 ) rst ( 4 , 4 ) = G * Jxx / L rst ( 10 , 4 ) = - rst ( 4 , 4 ) rst ( 3 , 5 ) = rst ( 5 , 3 ) rst ( 5 , 5 ) = 4.0d0 * E * Iyy / L rst ( 9 , 5 ) = - rst ( 11 , 3 ) rst ( 11 , 5 ) = 2.0d0 * E * Iyy / L rst ( 2 , 6 ) = rst ( 6 , 2 ) rst ( 6 , 6 ) = 4.0d0 * E * Izz / L rst ( 8 , 6 ) = - rst ( 12 , 2 ) rst ( 12 , 6 ) = 2.0d0 * E * Izz / L rst ( 1 , 7 ) = rst ( 7 , 1 ) rst ( 7 , 7 ) = rst ( 1 , 1 ) rst ( 2 , 8 ) = rst ( 8 , 2 ) rst ( 6 , 8 ) = rst ( 8 , 6 ) rst ( 8 , 8 ) = rst ( 2 , 2 ) rst ( 12 , 8 ) = - rst ( 6 , 2 ) rst ( 3 , 9 ) = rst ( 9 , 3 ) rst ( 5 , 9 ) = rst ( 9 , 5 ) rst ( 9 , 9 ) = rst ( 3 , 3 ) rst ( 11 , 9 ) = - rst ( 5 , 3 ) rst ( 4 , 10 ) = rst ( 10 , 4 ) rst ( 10 , 10 ) = rst ( 4 , 4 ) rst ( 3 , 11 ) = rst ( 11 , 3 ) rst ( 5 , 11 ) = rst ( 11 , 5 ) rst ( 9 , 11 ) = rst ( 11 , 9 ) rst ( 11 , 11 ) = rst ( 5 , 5 ) rst ( 2 , 12 ) = rst ( 12 , 2 ) rst ( 6 , 12 ) = rst ( 12 , 6 ) rst ( 8 , 12 ) = rst ( 12 , 8 ) rst ( 12 , 12 ) = rst ( 6 , 6 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ pure function b3d_mass_matrix ( this , rule ) result ( rst ) !! Computes the mass matrix for the element. class ( beam_element_3d ), intent ( in ) :: this !! The beam_element_3d object. integer ( int32 ), intent ( in ), optional :: rule !! The integration rule. The rule must be one of the following: !! !! - MECH_ONE_POINT_INTEGRATION_RULE !! !! - MECH_TWO_POINT_INTEGRATION_RULE !! !! - MECH_THREE_POINT_INTEGRATION_RULE !! !! - MECH_FOUR_POINT_INTEGRATION_RULE !! !! The default integration rule is MECH_TWO_POINT_INTEGRATION_RULE. real ( real64 ), allocatable , dimension (:,:) :: rst !! The resulting matrix. ! Local Variables real ( real64 ) :: rho , L real ( real64 ), allocatable , dimension (:,:) :: T , Tt ! Initialization rho = this % material % density L = this % length () ! Compute the rotation matrix T = this % rotation_matrix () Tt = transpose ( T ) ! Compute the mass matrix allocate ( rst ( 12 , 12 ), source = 0.0d0 ) rst ( 1 , 1 ) = L * rho / 3.0d0 rst ( 7 , 1 ) = L * rho / 6.0d0 rst ( 2 , 2 ) = 1.3d1 * L * rho / 3.5d1 rst ( 6 , 2 ) = 1.1d1 * rho * L ** 2 / 2.1d2 rst ( 8 , 2 ) = 9.0d0 * L * rho / 7.0d1 rst ( 12 , 2 ) = - 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 3 , 3 ) = 1.3d0 * rho * L / 3.5d1 rst ( 5 , 3 ) = - 1.1d0 * rho * L ** 2 / 2.1d2 rst ( 9 , 3 ) = 9.0d0 * rho * L / 7.0d1 rst ( 11 , 3 ) = 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 4 , 4 ) = rho * L / 3.0d0 rst ( 10 , 4 ) = rho * L / 6.0d0 rst ( 3 , 5 ) = rst ( 5 , 3 ) rst ( 5 , 5 ) = rho * L ** 3 / 1.05d2 rst ( 9 , 5 ) = - 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 11 , 5 ) = - rho * L ** 3 / 1.4d2 rst ( 2 , 6 ) = rst ( 6 , 2 ) rst ( 6 , 6 ) = rho * L ** 3 / 1.05d2 rst ( 8 , 6 ) = 1.3d1 * rho * L ** 2 / 4.2d2 rst ( 12 , 6 ) = - rho * L ** 3 / 1.4d2 rst ( 1 , 7 ) = rst ( 7 , 1 ) rst ( 7 , 7 ) = rst ( 1 , 1 ) rst ( 2 , 8 ) = rst ( 8 , 2 ) rst ( 6 , 8 ) = rst ( 8 , 6 ) rst ( 8 , 8 ) = rst ( 2 , 2 ) rst ( 12 , 8 ) = - 1.1d1 * rho * L ** 2 / 2.1d2 rst ( 3 , 9 ) = rst ( 9 , 3 ) rst ( 5 , 9 ) = rst ( 9 , 5 ) rst ( 9 , 9 ) = rst ( 3 , 3 ) rst ( 11 , 9 ) = 1.1d1 * rho * L ** 2 / 2.1d2 rst ( 4 , 10 ) = rst ( 10 , 4 ) rst ( 10 , 10 ) = rst ( 4 , 4 ) rst ( 3 , 11 ) = rst ( 11 , 3 ) rst ( 9 , 11 ) = rst ( 11 , 9 ) rst ( 11 , 11 ) = rst ( 5 , 5 ) rst ( 2 , 12 ) = rst ( 12 , 2 ) rst ( 6 , 12 ) = rst ( 12 , 6 ) rst ( 8 , 12 ) = rst ( 12 , 8 ) rst ( 12 , 12 ) = rst ( 6 , 6 ) ! Apply the transformation rst = matmul ( Tt , matmul ( rst , T )) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_structural.f90.html"},{"title":"dynamics_system_id.f90 – DYNAMICS","text":"Contents Modules dynamics_system_id Source Code dynamics_system_id.f90 Source Code module dynamics_system_id use iso_fortran_env use ferror use dynamics_error_handling use diffeq use fstats implicit none private public :: dynamic_system_measurement public :: model_information public :: siso_model_fit_least_squares public :: ode_integrator public :: regression_statistics public :: iteration_controls public :: lm_solver_options public :: convergence_info public :: iteration_update public :: constraint_equations interface subroutine constraint_equations ( xg , fg , xc , p , fc , args ) !! An interface to a set of routines for defining constraint !! equations to the fitting process. use iso_fortran_env , only : real64 real ( real64 ), intent ( in ), dimension (:) :: xg !! An N-element array containing the N independent variable !! values for the N differential equation solution points. real ( real64 ), intent ( in ), dimension (:) :: fg !! An N-element array containing the N differential equation !! solution points. real ( real64 ), intent ( in ), dimension (:) :: xc !! An M-element array containing the M independent variable !! values for the M constraint equations. real ( real64 ), intent ( in ), dimension (:) :: p !! An array containing the model parameters. real ( real64 ), intent ( out ), dimension (:) :: fc !! An M-element array where the values of the constraint !! equations should be written. class ( * ), intent ( inout ), optional :: args !! An optional argument that can be used to pass data in/out !! of this routine. end subroutine end interface type dynamic_system_measurement !! A container of a single measurement data set. real ( real64 ), allocatable , dimension (:) :: t !! The time points at which the measurements were taken. real ( real64 ), allocatable , dimension (:) :: output !! The output data. real ( real64 ), allocatable , dimension (:) :: input !! The input data. end type type model_information !! A container for model information. real ( real64 ), allocatable , dimension (:) :: model !! An array containing the model parameters. class ( base_interpolator ), pointer :: excitation !! An interpolation object allowing sampling of the excitation !! function. class ( * ), pointer :: user_info !! Information the user has passed along. end type type regression_information !! A container of information being shared with the regression function. integer ( int32 ), allocatable , dimension (:,:) :: start_stop !! An N-by-2 matrix containing the starting indices of each data !! set in the first column, and the ending indices of each data !! set in the second column. class ( ode_integrator ), pointer :: integrator !! A pointer to the ODE integrator. integer ( int32 ) :: solution_index !! The column index of the solution component to extract from the !! ODE solver output. Do not account for the time vector (e.g. !! enter a value of 1 to extract the first solution component.) real ( real64 ), allocatable , dimension (:,:) :: initial_conditions !! The initial conditions array to pass to the ODE solver. real ( real64 ), allocatable , dimension (:) :: excitation_data !! An array of excitation data to pass to the ODE solver. procedure ( ode ), pointer , nopass :: ode_routine !! The routine, defined by the calling code, containing the ODE's !! to solve. logical :: uses_constraints !! True if constraint equations are to be utilized; else, false. procedure ( constraint_equations ), pointer , nopass :: constraints !! A pointer to the constraint equations routine. class ( * ), pointer :: user_info !! Information the user has passed along. end type interface siso_model_fit_least_squares module procedure :: siso_model_fit_least_squares_1 module procedure :: siso_model_fit_least_squares_2 end interface contains ! ------------------------------------------------------------------------------ subroutine siso_model_fit_least_squares_1 ( fcn , x , ic , p , integrator , ind , & maxp , minp , stats , alpha , controls , settings , info , status , cov , xc , yc , & constraints , weights , args , & err ) !! Attempts to fit a model of a single-intput, single-output (SISO) dynamic !! system by means of an iterative least-squares solver. The algorithm !! computes the solution to the differential equations numerically, and !! compares the output to the known solution via a Levenberg-Marquardt !! least-squares solver. procedure ( ode ), pointer , intent ( in ) :: fcn !! The routine containing the ODE's being fit. To communicate !! model parameters and other relevant information, an instance of the !! [[model_information]] type is passed to the optional argument of this !! routine. Use the \"select type\" construct to access this information. class ( dynamic_system_measurement ), intent ( in ), dimension (:) :: x !! An M-element array of arrays with each array containing the measured !! input and output of the system being identified. real ( real64 ), intent ( in ), dimension (:) :: ic !! The initial condition vector for the equations in fcn. real ( real64 ), intent ( inout ), dimension (:) :: p !! An N-element array containing an initial guess at the parameters. !! On output, the computed model parameters. class ( ode_integrator ), intent ( inout ), optional , target :: integrator !! The integrator to use when solving the system equations. If not !! supplied, the default integrator will be used. The default !! integrator is a Runge-Kutta integrator (Dormand-Prince). integer ( int32 ), intent ( in ), optional :: ind !! The index of the ODE in fcn providing the output to fit. If !! no value is supplied, a value of 1 will be utilized. real ( real64 ), intent ( in ), optional , dimension (:) :: maxp !! An optional N-element array that can be used as upper limits on the !! parameter values. If no upper limit is requested for a particular !! parameter, utilize a very large value. The internal default is to !! utilize huge() as a value. real ( real64 ), intent ( in ), optional , dimension (:) :: minp !! An optional N-element array that can be used as lower limits on the !! parameter values. If no lower limit is requested for a particalar !! parameter, utilize a very large magnitude, but negative, value. The !! internal default is to utilize -huge() as a value. type ( regression_statistics ), intent ( out ), optional , dimension (:) :: stats !! An optional N-element array that, if supplied, will be used to !! return statistics about the fit for each parameter. real ( real64 ), intent ( in ), optional :: alpha !! The significance level at which to evaluate the confidence !! intervals. The default value is 0.05 such that a 95% confidence !! interval is calculated. type ( iteration_controls ), intent ( in ), optional :: controls !! An optional input providing custom iteration controls. type ( lm_solver_options ), intent ( in ), optional :: settings !! An optional input providing custom settings for the solver. type ( convergence_info ), intent ( out ), optional :: info !! An optional output that can be used to gain information about the !! iterative solution and the nature of the convergence. procedure ( iteration_update ), pointer , intent ( in ), optional :: status !! An optional pointer to a routine that can be used to extract !! iteration information. real ( real64 ), intent ( out ), optional , dimension (:,:) :: cov !! An optional N-by-N matrix that, if supplied, will be used to return !! the covariance matrix. real ( real64 ), intent ( in ), optional , dimension (:) :: xc !! An optional NC-element array containing the values of the independent !! variable at which the constraint equations are defined. real ( real64 ), intent ( in ), optional , dimension (:) :: yc !! An optional NC-element array containing the constraint function !! values at xc. procedure ( constraint_equations ), pointer , optional :: constraints !! An optional input, that must be utilized with the xc and yc inputs, !! but allows for the implementation of additional constraints on the !! solution outside of the differential equations being fitted. An !! example usage would be an additional set of quasi-static tests that !! could help identify a stiffness term, for instance. Other uses of !! course can be imagined. real ( real64 ), intent ( in ), optional , dimension (:) :: weights !! An optional array containing weighting factors for every equation. class ( * ), intent ( inout ), optional , target :: args !! User-defined information to pass along to fcn. These arguments, !! if supplied, will be passed through to fcn by means of the !! [[model_information]] type. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. ! Local Variables integer ( int32 ) :: i , i1 , i2 , n , ni , npts , nc , flag real ( real64 ), allocatable , dimension (:) :: t , f , ymod , resid class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( runge_kutta_45 ), target :: default_ode_solver type ( regression_information ) :: addinfo procedure ( regression_function ), pointer :: fcnptr type ( iteration_controls ) :: def_tol ; ! Initialization if ( present ( err )) then errmgr => err else errmgr => deferr end if if ( present ( xc ) . and . present ( yc ) . and . present ( constraints )) then nc = size ( xc ) if ( size ( yc ) /= nc ) then call report_array_size_error ( \"siso_model_fit_least_squares_1\" , & \"yc\" , nc , size ( yc ), errmgr ) return end if else nc = 0 end if n = size ( x ) fcnptr => nlsq_fun if ( present ( controls )) then def_tol = controls else call def_tol % set_to_default () def_tol % change_in_solution_tolerance = 1.0d-12 def_tol % residual_tolerance = sqrt ( epsilon ( 1.0d0 )) end if allocate ( addinfo % start_stop ( n , 2 ), stat = flag ) if ( flag /= 0 ) go to 100 i1 = 1 i2 = 0 npts = 0 do i = 1 , n ni = size ( x ( i )% t ) npts = npts + ni i2 = i2 + ni addinfo % start_stop ( i , 1 ) = i1 addinfo % start_stop ( i , 2 ) = i2 i1 = i2 + 1 end do npts = npts + nc allocate ( t ( npts ), f ( npts ), addinfo % excitation_data ( npts ), ymod ( npts ), & resid ( npts ), stat = flag ) if ( flag /= 0 ) go to 100 do i = 1 , n i1 = addinfo % start_stop ( i , 1 ) i2 = addinfo % start_stop ( i , 2 ) t ( i1 : i2 ) = x ( i )% t addinfo % excitation_data ( i1 : i2 ) = x ( i )% input f ( i1 : i2 ) = x ( i )% output end do if ( nc > 0 ) then i1 = i2 + 1 t ( i1 : npts ) = xc f ( i1 : npts ) = yc end if if ( present ( integrator )) then addinfo % integrator => integrator else addinfo % integrator => default_ode_solver end if allocate ( addinfo % initial_conditions ( 1 , size ( ic ))) addinfo % initial_conditions ( 1 ,:) = ic if ( present ( ind )) then addinfo % solution_index = ind else addinfo % solution_index = 1 end if addinfo % ode_routine => fcn if ( nc > 0 ) then addinfo % uses_constraints = . true . addinfo % constraints => constraints else addinfo % uses_constraints = . false . end if if ( present ( args )) addinfo % user_info => args ! Solve the system call nonlinear_least_squares ( fcnptr , t , f , p , ymod , resid , maxp = maxp , & minp = minp , stats = stats , alpha = alpha , controls = def_tol , & settings = settings , info = info , status = status , cov = cov , & args = addinfo , err = errmgr , weights = weights ) if ( errmgr % has_error_occurred ()) return ! End return ! Memory Error 100 continue call report_memory_error ( \"siso_model_fit_least_squares_1\" , flag , errmgr ) end subroutine ! -------------------- subroutine siso_model_fit_least_squares_2 ( fcn , x , ic , p , integrator , ind , & maxp , minp , stats , alpha , controls , settings , info , status , cov , xc , yc , & constraints , weights , args , & err ) !! Attempts to fit a model of a single-intput, single-output (SISO) dynamic !! system by means of an iterative least-squares solver. The algorithm !! computes the solution to the differential equations numerically, and !! compares the output to the known solution via a Levenberg-Marquardt !! least-squares solver. procedure ( ode ), pointer , intent ( in ) :: fcn !! The routine containing the ODE's being fit. To communicate !! model parameters and other relevant information, an instance of the !! [[model_information]] type is passed to the optional argument of this !! routine. Use the \"select type\" construct to access this information. class ( dynamic_system_measurement ), intent ( in ), dimension (:) :: x !! An M-element array of arrays with each array containing the measured !! input and output of the system being identified. real ( real64 ), intent ( in ), dimension (:,:) :: ic !! An M-by-NEQN matrix of initial condition vectors for the NEQN !! equations in fcn, one set for each of the M sets of data in x. real ( real64 ), intent ( inout ), dimension (:) :: p !! An N-element array containing an initial guess at the parameters. !! On output, the computed model parameters. class ( ode_integrator ), intent ( inout ), optional , target :: integrator !! The integrator to use when solving the system equations. If not !! supplied, the default integrator will be used. The default !! integrator is a Runge-Kutta integrator (Dormand-Prince). integer ( int32 ), intent ( in ), optional :: ind !! The index of the ODE in fcn providing the output to fit. If !! no value is supplied, a value of 1 will be utilized. real ( real64 ), intent ( in ), optional , dimension (:) :: maxp !! An optional N-element array that can be used as upper limits on the !! parameter values. If no upper limit is requested for a particular !! parameter, utilize a very large value. The internal default is to !! utilize huge() as a value. real ( real64 ), intent ( in ), optional , dimension (:) :: minp !! An optional N-element array that can be used as lower limits on the !! parameter values. If no lower limit is requested for a particalar !! parameter, utilize a very large magnitude, but negative, value. The !! internal default is to utilize -huge() as a value. type ( regression_statistics ), intent ( out ), optional , dimension (:) :: stats !! An optional N-element array that, if supplied, will be used to !! return statistics about the fit for each parameter. real ( real64 ), intent ( in ), optional :: alpha !! The significance level at which to evaluate the confidence !! intervals. The default value is 0.05 such that a 95% confidence !! interval is calculated. type ( iteration_controls ), intent ( in ), optional :: controls !! An optional input providing custom iteration controls. type ( lm_solver_options ), intent ( in ), optional :: settings !! An optional input providing custom settings for the solver. type ( convergence_info ), intent ( out ), optional :: info !! An optional output that can be used to gain information about the !! iterative solution and the nature of the convergence. procedure ( iteration_update ), pointer , intent ( in ), optional :: status !! An optional pointer to a routine that can be used to extract !! iteration information. real ( real64 ), intent ( out ), optional , dimension (:,:) :: cov !! An optional N-by-N matrix that, if supplied, will be used to return !! the covariance matrix. real ( real64 ), intent ( in ), optional , dimension (:) :: xc !! An optional NC-element array containing the values of the independent !! variable at which the constraint equations are defined. real ( real64 ), intent ( in ), optional , dimension (:) :: yc !! An optional NC-element array containing the constraint function !! values at xc. procedure ( constraint_equations ), pointer , optional :: constraints !! An optional input, that must be utilized with the xc and yc inputs, !! but allows for the implementation of additional constraints on the !! solution outside of the differential equations being fitted. An !! example usage would be an additional set of quasi-static tests that !! could help identify a stiffness term, for instance. Other uses of !! course can be imagined. real ( real64 ), intent ( in ), optional , dimension (:) :: weights !! An optional array containing weighting factors for every equation. class ( * ), intent ( inout ), optional , target :: args !! User-defined information to pass along to fcn. These arguments, !! if supplied, will be passed through to fcn by means of the !! [[model_information]] type. class ( errors ), intent ( inout ), optional , target :: err !! An error handling object. ! Local Variables integer ( int32 ) :: i , i1 , i2 , n , ni , npts , nc , flag real ( real64 ), allocatable , dimension (:) :: t , f , ymod , resid class ( errors ), pointer :: errmgr type ( errors ), target :: deferr type ( runge_kutta_45 ), target :: default_ode_solver type ( regression_information ) :: addinfo procedure ( regression_function ), pointer :: fcnptr type ( iteration_controls ) :: def_tol ! Initialization & Error Checking if ( present ( err )) then errmgr => err else errmgr => deferr end if if ( present ( xc ) . and . present ( yc ) . and . present ( constraints )) then nc = size ( xc ) if ( size ( yc ) /= nc ) then call report_array_size_error ( \"siso_model_fit_least_squares_2\" , & \"yc\" , nc , size ( yc ), errmgr ) return end if else nc = 0 end if n = size ( x ) fcnptr => nlsq_fun if ( present ( controls )) then def_tol = controls else call def_tol % set_to_default () def_tol % change_in_solution_tolerance = 1.0d-12 def_tol % residual_tolerance = sqrt ( epsilon ( 1.0d0 )) end if if ( size ( ic , 1 ) /= n ) then call report_matrix_size_error ( \"siso_model_fit_least_squares_2\" , \"ic\" , & n , size ( ic , 2 ), size ( ic , 1 ), size ( ic , 2 ), errmgr ) return end if allocate ( addinfo % start_stop ( n , 2 ), stat = flag ) if ( flag /= 0 ) go to 100 i1 = 1 i2 = 0 npts = 0 do i = 1 , n ni = size ( x ( i )% t ) npts = npts + ni i2 = i2 + ni addinfo % start_stop ( i , 1 ) = i1 addinfo % start_stop ( i , 2 ) = i2 i1 = i2 + 1 end do npts = npts + nc allocate ( t ( npts ), f ( npts ), addinfo % excitation_data ( npts ), ymod ( npts ), & resid ( npts ), stat = flag ) if ( flag /= 0 ) go to 100 do i = 1 , n i1 = addinfo % start_stop ( i , 1 ) i2 = addinfo % start_stop ( i , 2 ) t ( i1 : i2 ) = x ( i )% t addinfo % excitation_data ( i1 : i2 ) = x ( i )% input f ( i1 : i2 ) = x ( i )% output end do if ( nc > 0 ) then i1 = i2 + 1 t ( i1 : npts ) = xc f ( i1 : npts ) = yc end if if ( present ( integrator )) then addinfo % integrator => integrator else addinfo % integrator => default_ode_solver end if addinfo % initial_conditions = ic if ( present ( ind )) then addinfo % solution_index = ind else addinfo % solution_index = 1 end if addinfo % ode_routine => fcn if ( nc > 0 ) then addinfo % uses_constraints = . true . addinfo % constraints => constraints else addinfo % uses_constraints = . false . end if if ( present ( args )) addinfo % user_info => args ! Solve the system call nonlinear_least_squares ( fcnptr , t , f , p , ymod , resid , maxp = maxp , & minp = minp , stats = stats , alpha = alpha , controls = def_tol , & settings = settings , info = info , status = status , cov = cov , & args = addinfo , err = errmgr , weights = weights ) if ( errmgr % has_error_occurred ()) return ! End return ! Memory Error 100 continue call report_memory_error ( \"siso_model_fit_least_squares_2\" , flag , errmgr ) end subroutine ! -------------------- subroutine nlsq_fun ( t , p , f , check , args ) !! The routine called by the nonlinear least-squares solver from the !! siso_model_fit_least_squares routine. real ( real64 ), intent ( in ), dimension (:) :: t !! All of the time values from every data set supplied to the !! least-squares solver. The args instance contains information on !! how to break apart this array. real ( real64 ), intent ( in ), dimension (:) :: p !! An array containing the model parameters. real ( real64 ), intent ( out ), dimension (:) :: f !! An array, the same size as t, where the function values will be !! written. logical , intent ( out ) :: check !! Set to true to force a stop to the iteration process; else, set !! to false to allow iterations to proceed normally. class ( * ), intent ( inout ), optional :: args !! A regression_information object containing information on how to !! arrange and solve the differential equations. ! Local Variables type ( model_information ) :: ode_info integer ( int32 ) :: i , n , ind , i1 , i2 integer ( int32 ), allocatable , dimension (:,:) :: limits real ( real64 ), allocatable , dimension (:) :: excitation , ici real ( real64 ), allocatable , dimension (:,:) :: sol , ic class ( ode_integrator ), pointer :: integrator type ( linear_interpolator ), target :: forcing_function type ( ode_container ) :: mdl type ( errors ) :: err logical :: uses_constraints procedure ( constraint_equations ), pointer :: constraints class ( * ), pointer :: user_info ! Get the supplied information select type ( args ) class is ( regression_information ) limits = args % start_stop integrator => args % integrator ind = args % solution_index + 1 ! +1 accounts for the time vector excitation = args % excitation_data ic = args % initial_conditions mdl % fcn => args % ode_routine if ( associated ( args % user_info )) then ode_info % user_info => args % user_info user_info => args % user_info end if uses_constraints = args % uses_constraints if ( uses_constraints ) constraints => args % constraints end select ! Initialization check = . false . n = size ( limits , 1 ) ode_info % model = p ! Cycle over each segment and compute the solution do i = 1 , n ! Get the locations within the array at which the relevant data is ! located i1 = limits ( i , 1 ) i2 = limits ( i , 2 ) ! Set up the interpolator for the forcing term call forcing_function % initialize ( t ( i1 : i2 ), excitation ( i1 : i2 ), err = err ) if ( err % has_error_occurred ()) go to 10 ode_info % excitation => forcing_function ! Solve the ODE's if ( size ( ic , 1 ) == 1 ) then ici = ic ( 1 ,:) else ici = ic ( i ,:) end if call integrator % clear_buffer () call integrator % solve ( mdl , t ( i1 : i2 ), ici , args = ode_info , err = err ) if ( err % has_error_occurred ()) go to 10 sol = integrator % get_solution () f ( i1 : i2 ) = sol (:, ind ) end do ! Constraints if ( uses_constraints ) then if ( associated ( user_info )) then call constraints ( t ( 1 : i2 ), f ( 1 : i2 ), t ( i2 + 1 :), p , f ( i2 + 1 :), & args = user_info ) else call constraints ( t ( 1 : i2 ), f ( 1 : i2 ), t ( i2 + 1 :), p , f ( i2 + 1 :)) end if end if ! End return ! Error Handling 10 continue check = . true . ! terminate iterations return end subroutine ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_system_id.f90.html"},{"title":"dynamics_vibrations.f90 – DYNAMICS","text":"Contents Modules dynamics_vibrations Source Code dynamics_vibrations.f90 Source Code module dynamics_vibrations use iso_fortran_env use peaks use ieee_arithmetic implicit none private public :: q_factor public :: estimate_bandwidth public :: logarithmic_decrement public :: damping_from_log_decrement public :: find_free_response_properties public :: rise_time public :: find_settling_amplitude public :: damping_from_fractional_overshoot public :: evaluate_step_response contains ! ------------------------------------------------------------------------------ pure elemental function q_factor ( zeta ) result ( rst ) !! Estimates the Q-factor for a vibratory system. The Q-factor is computed !! Q = \\frac{1}{2 \\zeta}. real ( real64 ), intent ( in ) :: zeta !! The damping ratio. real ( real64 ) :: rst !! The Q-factor. ! Process rst = 1.0d0 / ( 2.0d0 * zeta ) end function ! ------------------------------------------------------------------------------ pure elemental function estimate_bandwidth ( fn , zeta ) result ( rst ) !! Estimates the bandwidth of the resonant mode of a vibratory system. !! The bandwidth is the width of the range of frequencies for which the !! energy is at least half its peak value and is computed as !! \\Delta f = \\frac{f_n}{Q}. real ( real64 ), intent ( in ) :: fn !! The resonant frequency. The units are not important; however, !! the units of the output will be the same as the units of this !! parameter. real ( real64 ), intent ( in ) :: zeta !! The damping ratio. real ( real64 ) :: rst !! The bandwidth. ! Process rst = fn / q_factor ( zeta ) end function ! ------------------------------------------------------------------------------ pure elemental function logarithmic_decrement ( x1 , x2 , n ) result ( rst ) !! Computes the logarithmic decrement given the value of two successive !! peaks in the time history of the free vibratory response of the system. !! The logarithmic decrement is calculated as follows. !! !! \\delta = \\frac{1}{N} \\ln \\left( \\frac{x(t)}{x(t + N T)} \\right) = !! \\frac{1}{N} \\ln \\left( \\frac{x_1}{x_2} \\right) real ( real64 ), intent ( in ) :: x1 !! The amplitude of the first peak. real ( real64 ), intent ( in ) :: x2 !! The amplitude of the second peak that occurs N periods after the !! first. integer ( int32 ), intent ( in ) :: n !! The number of periods of oscillation seperating the two peaks. real ( real64 ) :: rst !! The logarithmic decrement \\delta. ! Process rst = ( 1.0d0 / n ) * log ( x1 / x2 ) end function ! ------------------------------------------------------------------------------ pure elemental function damping_from_log_decrement ( delta ) result ( rst ) !! Computes the damping ratio from the logarithmic decrement \\delta. !! The damping ratio is related to the logarithmic decrement by the !! following relationship. !! !! \\zeta = \\frac{\\delta}{\\sqrt{4 \\pi^2 + \\delta^2}} real ( real64 ), intent ( in ) :: delta !! The logarithmic decrement. real ( real64 ) :: rst !! The damping ratio. ! Process real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) rst = delta / sqrt ( 4.0d0 * pi ** 2 + delta ** 2 ) end function ! ------------------------------------------------------------------------------ subroutine find_free_response_properties ( t , x , delta , fn , x1 , x2 , t1 , t2 , s , n ) !! Given a free-response time history, this routine attempts to find the !! logarithmic decrement and resonant frequency of a vibratory system. The !! logarithmic decrement is estimated by finding successive peaks by !! means of peak detection. real ( real64 ), intent ( in ), dimension (:) :: t !! An N-element array containing the values in time real ( real64 ), intent ( in ), dimension (:) :: x !! An N-element array containing the response sampled at the time points !! given in t. real ( real64 ), intent ( out ) :: delta !! The logarithmic decrement estimate. If sufficient peaks cannot be !! located, the routine returns NaN. real ( real64 ), intent ( out ) :: fn !! The damped resonant frequency in units of Hz, assuming that the !! time values are in seconds. If the time units are not in seconds, !! the units will be cycle/unit time with unit time being the units !! in which t is supplied. If sufficient peaks cannot be located, the !! routine returns NaN. real ( real64 ), intent ( out ), optional :: x1 !! An optional parameter that, if provided, allows for the routine to !! return the amplitude of the first peak. If sufficient peaks cannot !! be located, the routine returns NaN. real ( real64 ), intent ( out ), optional :: x2 !! An optional parameter that, if provided, allows for the routine to !! return the amplitude of the second peak. If sufficient peaks cannot !! be located, the routine returns NaN. real ( real64 ), intent ( out ), optional :: t1 !! An optional parameter that, if provided, allows for the routine to !! return the time at which the first peak was located. If sufficient !! peaks cannot be located, the routine returns NaN. real ( real64 ), intent ( out ), optional :: t2 !! An optional parameter that, if provided, allows for the routine to !! return the time at which the second peak was located. If sufficient !! peaks cannot be located, the routine returns NaN. real ( real64 ), intent ( in ), optional :: s !! An optional input that, if provided, allows for control of the !! sensitivity of the peak detection algorithm. The default is 0.1% !! of the peak-peak amplitude of the signal. integer ( int32 ), intent ( in ), optional :: n !! An optional input that, if provided, determines the number of !! periods to allow between peak selection for the logarithmic !! decrement calculation. The default is 1. ! Local Variables integer ( int32 ) :: np , i1 , i2 , j2 real ( real64 ) :: xmax , xmin , dx , x1p , x2p , t1p , t2p , nan integer ( int32 ), allocatable , dimension (:) :: maxind , minind real ( real64 ), allocatable , dimension (:) :: maxvals , minvals ! Determine a suitable sensitivity to peak detection if ( present ( s )) then dx = s else xmax = maxval ( x ) xmin = minval ( x ) dx = 1.0d-3 * ( xmax - xmin ) end if ! Peak Count if ( present ( n )) then np = n else np = 1 end if ! Additional initialization nan = ieee_value ( nan , IEEE_QUIET_NAN ) delta = nan fn = nan t1p = nan t2p = nan x1p = nan x2p = nan ! Locate peaks call peak_detect ( x , dx , maxind , maxvals , minind , minvals ) if ( size ( maxind ) < 2 ) then ! Return NaN's as we couldn't find enough peaks go to 10 end if i1 = maxind ( 1 ) np = min ( np , size ( maxind ) - 1 ) j2 = np + 1 i2 = maxind ( j2 ) t1p = t ( i1 ) t2p = t ( i2 ) x1p = x ( i1 ) x2p = x ( i2 ) delta = logarithmic_decrement ( x1p , x2p , np ) fn = np / ( t2p - t1p ) ! End 10 continue if ( present ( x1 )) x1 = x1p if ( present ( x2 )) x2 = x2p if ( present ( t1 )) t1 = t1p if ( present ( t2 )) t2 = t2p end subroutine ! ------------------------------------------------------------------------------ pure elemental function rise_time ( wn , zeta ) result ( rst ) !! Computes the rise time for an underdamped, second-order system. The !! rise time is the time it takes for the system response to go from 0% !! to 100% of its final value and is given by the following relationship. !! !! t_r = \\frac{1}{\\omega_d} \\left( \\pi - !! \\arctan \\frac{\\sqrt{1 - zeta^2}}{\\zeta} \\right) real ( real64 ), intent ( in ) :: wn !! The resonant frequency of the system, in rad/s. real ( real64 ), intent ( in ) :: zeta !! The damping ratio of the system. This value must be less than 1 !! as this relationship is only valid for an underdamped system. real ( real64 ) :: rst !! The rise time, in units of seconds. ! Local Variables real ( real64 ) :: arg ! Parameters real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) ! Process arg = sqrt ( 1.0d0 - zeta ** 2 ) rst = ( 1.0d0 / ( wn * arg )) * ( pi - atan ( arg / zeta )) end function ! ------------------------------------------------------------------------------ pure function find_settling_amplitude ( x ) result ( rst ) use fftpack , only : rfft !! Estimates the settling amplitude for a step response. real ( real64 ), intent ( in ), dimension (:) :: x !! The step response of the system. real ( real64 ) :: rst !! The settling amplitude of the step response. ! Local Variables real ( real64 ), allocatable , dimension (:) :: xfft ! Compute the FFT of X and normalize xfft = rfft ( x ) / size ( x ) ! We only need the DC component rst = xfft ( 1 ) end function ! ------------------------------------------------------------------------------ pure function damping_from_fractional_overshoot ( x ) result ( rst ) !! Employs the method of fractional overshoot to estimate the damping ratio !! from the response of a system to a step input. This method is useful !! for cases where the damping ratio is between approximately 0.5 to 0.8. !! In such range, the logarithmic decrement approach becomes less precise. !! !! The fractional overshoot method locates the amplitude of the first !! peak of oscillation (x_p) and the settling amplitude (x_f), and !! the estimates the damping ratio as follows. !! !! s = \\frac{x_p - x_f}{x_f} !! !! \\zeta = \\frac{1}{\\sqrt{1 + \\left( \\frac{\\pi}{\\ln{s}} \\right)^2}} real ( real64 ), intent ( in ), dimension (:) :: x !! The step response of the system. real ( real64 ) :: rst !! The estimated damping ratio. ! Parameters real ( real64 ), parameter :: pi = 2.0d0 * acos ( 0.0d0 ) ! Local Variables real ( real64 ) :: xp , xf , s ! Locate the amplitude terms xp = maxval ( abs ( x )) xf = abs ( find_settling_amplitude ( x )) s = ( xp - xf ) / xf ! Compute the damping ratio rst = 1.0d0 / sqrt ( 1.0d0 + ( pi / log ( s )) ** 2 ) end function ! ------------------------------------------------------------------------------ pure elemental function evaluate_step_response ( wn , zeta , xs , t ) result ( rst ) !! Evaluates the response of an underdamped single-degree-of-freedom, !! linear system to a step function of amplitude X_s. !! !! The step function response of an underdamped linear SDOF system is given !! as follows. !! !! \\ddot{x} + 2 \\zeta \\omega_n \\dot{x} + \\omega_n^2 x = \\frac{F(t)}{m} !! !! \\frac{x(t)}{X_s} = 1 - e^{-\\zeta \\omega_n t} \\left( !! \\frac{\\zeta \\omega_n}{\\omega_d} \\sin{\\omega_d t} + \\cos{\\omega_d t} !! \\right) !! !! where, !! !! \\omega_d = \\omega_n \\sqrt{1 - \\zeta^2} !! !! and !! !! X_s = \\frac{F}{k} real ( real64 ), intent ( in ) :: wn !! The resonant frequency, in rad/s. real ( real64 ), intent ( in ) :: zeta !! The damping ratio. real ( real64 ), intent ( in ) :: xs !! The amplitude of the step input. real ( real64 ), intent ( in ) :: t !! The point in time at which to evaluate the response (units = s). real ( real64 ) :: rst !! The step response. ! Local Variables real ( real64 ) :: wd , A ! Process wd = wn * sqrt ( 1.0d0 - zeta ** 2 ) A = zeta * wn / wd rst = xs * ( 1.0d0 - exp ( - zeta * wn * t ) * ( A * sin ( wd * t ) + cos ( wd * t ))) end function ! ------------------------------------------------------------------------------ end module","tags":"","loc":"sourcefile\\dynamics_vibrations.f90.html"}]} \ No newline at end of file From 7f1c85e5ded7b98f56952063797fafd436939e5c Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 27 May 2026 14:04:26 -0500 Subject: [PATCH 4/4] Update version info --- CMakeLists.txt | 2 +- fpm.toml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index eb88fe4a..5102b290 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -3,7 +3,7 @@ cmake_minimum_required(VERSION 3.24) project( dynamics LANGUAGES Fortran C CXX - VERSION 1.3.1 + VERSION 1.3.2 ) set(CMAKE_Fortran_STANDARD 2018) set(CMAKE_Fortran_STANDARD_REQUIRED TRUE) diff --git a/fpm.toml b/fpm.toml index 1e068087..78a09e45 100644 --- a/fpm.toml +++ b/fpm.toml @@ -1,5 +1,5 @@ name = "dynamics" -version = "1.3.1" +version = "1.3.2" license = "GPL-3.0" author = "Jason Christopherson" maintainer = "Jason Christopherson"