1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502 |
- PROGRAM ZBLAT3
- INTEGER NIN
- PARAMETER ( NIN
- INTEGER
- PARAMETER
- COMPLEX*16 ZERO, ONE
- PARAMETER
- $ ONE
- DOUBLE
- PARAMETER
- INTEGER
- PARAMETER
- INTEGER
- PARAMETER
- DOUBLE
- INTEGER
- LOGICAL
- $ TSTERR
- CHARACTER*1 TRANSA, TRANSB
- CHARACTER*6 SNAMET
- CHARACTER*32 SNAPS, SUMMRY
- COMPLEX*16 AA( NMAX*NMAX
- $ ALF( NALMAX
- $ BB( NMAX*NMAX
- $ BS( NMAX*NMAX
- $ CC( NMAX*NMAX
- $ W( 2*NMAX
- DOUBLE
- INTEGER
- LOGICAL
- CHARACTER*6 SNAMES( NSUBS
- DOUBLE
- LOGICAL
- EXTERNAL
- EXTERNAL
- INTRINSIC
- INTEGER
- LOGICAL
- CHARACTER*6 SRNAMT
- COMMON /INFOC/
- COMMON /SRNAMC/
- DATA /, , , ,
- $ , , , ,
- $ /
- READ( NIN, FMT
- READ( NIN, FMT
- OPEN( NOUT, FILE
- NOUTC
- READ( NIN, FMT
- READ( NIN, FMT
- TRACE
- IF( TRACE
- OPEN( NTRA, FILE
- END
- READ( NIN, FMT
- REWI
- READ( NIN, FMT
- READ( NIN, FMT
- READ( NIN, FMT
- READ( NIN, FMT
- IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX
- WRITE( NOUT, FMT
- GO
- END
- READ( NIN, FMT
- DO
- IF( IDIM( I
- WRITE( NOUT, FMT
- GO
- END
- 10 CONTINUE
- READ( NIN, FMT
- IF( NALF.LT.1.OR.NALF.GT.NALMAX
- WRITE( NOUT, FMT
- GO
- END
- READ( NIN, FMT
- READ( NIN, FMT
- IF( NBET.LT.1.OR.NBET.GT.NBEMAX
- WRITE( NOUT, FMT
- GO
- END
- READ( NIN, FMT
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- IF( .NOT.TSTERR
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- END
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- DO
- LTEST( I )
- 20 CONTINUE
- 30 READ( NIN, FMT
- DO
- IF( SNAMET.EQ.SNAMES( I )
- $ GO
- 40 CONTINUE
- WRITE( NOUT, FMT
- STOP
- 50 LTEST( I )
- GO
- 60 CONTINUE
- CLOSE
- EPS
- WRITE( NOUT, FMT
- N
- DO
- DO
- AB( I, J )
- 90 CONTINUE
- AB( J, NMAX
- AB( 1, NMAX
- C( J, 1 )
- 100 CONTINUE
- DO
- CC( J ) /2 - ( ( J + 1 )*J*( J - 1 ) )/
- 110 CONTINUE
- TRANSA
- TRANSB
- CALL
- $ AB( 1, NMAX
- $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
- SAME
- IF( .NOT.SAME.OR.ERR.NE.RZERO
- WRITE( NOUT, FMT
- STOP
- END
- TRANSB
- CALL
- $ AB( 1, NMAX
- $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
- SAME
- IF( .NOT.SAME.OR.ERR.NE.RZERO
- WRITE( NOUT, FMT
- STOP
- END
- DO
- AB( J, NMAX
- AB( 1, NMAX
- 120 CONTINUE
- DO
- CC( N /2 -
- $ ( ( J + 1 )*J*( J - 1 ) )/
- 130 CONTINUE
- TRANSA
- TRANSB
- CALL
- $ AB( 1, NMAX
- $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
- SAME
- IF( .NOT.SAME.OR.ERR.NE.RZERO
- WRITE( NOUT, FMT
- STOP
- END
- TRANSB
- CALL
- $ AB( 1, NMAX
- $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
- SAME
- IF( .NOT.SAME.OR.ERR.NE.RZERO
- WRITE( NOUT, FMT
- STOP
- END
- DO
- WRITE( NOUT, FMT
- IF( .NOT.LTEST( ISNUM )
- WRITE( NOUT, FMT
- ELSE
- SRNAMT
- IF( TSTERR
- CALL
- WRITE( NOUT, FMT
- END
- INFOT
- OK
- FATAL
- GO
- $ 180, 180 )ISNUM
- 140 CALL
- $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
- $ NMAX, AB, AA, AS, AB( 1, NMAX
- $ CC, CS, CT, G
- GO
- 150 CALL
- $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
- $ NMAX, AB, AA, AS, AB( 1, NMAX
- $ CC, CS, CT, G
- GO
- 160 CALL
- $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
- $ AA, AS, AB( 1, NMAX
- GO
- 170 CALL
- $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
- $ NMAX, AB, AA, AS, AB( 1, NMAX
- $ CC, CS, CT, G
- GO
- 180 CALL
- $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
- $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W
- GO
- 190 IF( FATAL.AND.SFATAL
- $ GO
- END
- 200 CONTINUE
- WRITE( NOUT, FMT
- GO
- 210 CONTINUE
- WRITE( NOUT, FMT
- GO
- 220 CONTINUE
- WRITE( NOUT, FMT
- 230 CONTINUE
- IF( TRACE
- $ CLOSE
- CLOSE
- STOP
- 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
- $ 'S THAN', F8.2 )
- 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 )
- 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
- $ 'THAN ', I2
- 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2
- 9995 FORMAT( ' TESTS OF THE COMPLEX*16 LEVEL 3 BLAS',
- $ 'OLLOWING PARAMETER VALUES WILL BE USED:' )
- 9994 FORMAT( ' FOR N ', 9I6
- 9993 FORMAT( ' FOR ALPHA ',
- $ 7( '(', F4.1, ',', F4.1, ') ', : ) )
- 9992 FORMAT( ' FOR BETA ',
- $ 7( '(', F4.1, ',', F4.1, ') ', : ) )
- 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
- $ / )
- 9990 FORMAT( , A6, , /' ******* T',
- $ 'ESTS ABANDONED *******' )
- 9989 FORMAT( ' ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
- $ 'ATED WRONGLY.', /, A1,
- $ , A1, /' AND RETURNED SAME = ', L1, ' AND ',
- $ 'ERR = ', F12.3, '.', /,
- $ , /' ******* TESTS ABANDONED ',
- $ '*******' )
- 9988 FORMAT( A6, L2
- 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
- 9986 FORMAT( / )
- 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
- 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
- END
- SUBROUTINE
- $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
- $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G
- COMPLEX*16 ZERO
- PARAMETER
- DOUBLE
- PARAMETER
- DOUBLE
- INTEGER
- LOGICAL
- CHARACTER*6 SNAME
- COMPLEX*16 A( NMAX, NMAX
- $ AS( NMAX*NMAX
- $ BB( NMAX*NMAX
- $ C( NMAX, NMAX
- $ CS( NMAX*NMAX
- DOUBLE
- INTEGER
- COMPLEX*16 ALPHA, ALS, BETA, BLS
- DOUBLE
- INTEGER
- $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
- $ MA, MB, MS, N, NA, NARGS, NB, NC, NS
- LOGICAL
- CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB
- CHARACTER*3 ICH
- LOGICAL
- LOGICAL
- EXTERNAL
- EXTERNAL
- INTRINSIC
- INTEGER
- LOGICAL
- COMMON /INFOC/
- DATA //
- NARGS
- NC
- RESET
- ERRMAX
- DO
- M
- DO
- N
- LDC
- IF( LDC.LT.NMAX
- $ LDC
- IF( LDC.GT.NMAX
- $ GO
- LCC
- NULL
- DO
- K
- DO
- TRANSA
- TRANA
- IF( TRANA
- MA
- NA
- ELSE
- MA
- NA
- END
- LDA
- IF( LDA.LT.NMAX
- $ LDA
- IF( LDA.GT.NMAX
- $ GO
- LAA
- CALL
- $ RESET, ZERO
- DO
- TRANSB
- TRANB
- IF( TRANB
- MB
- NB
- ELSE
- MB
- NB
- END
- LDB
- IF( LDB.LT.NMAX
- $ LDB
- IF( LDB.GT.NMAX
- $ GO
- LBB
- CALL
- $ LDB, RESET, ZERO
- DO
- ALPHA
- DO
- BETA
- CALL
- $ CC, LDC, RESET, ZERO
- NC
- TRANAS
- TRANBS
- MS
- NS
- KS
- ALS
- DO
- AS( I )
- 10 CONTINUE
- LDAS
- DO
- BS( I )
- 20 CONTINUE
- LDBS
- BLS
- DO
- CS( I )
- 30 CONTINUE
- LDCS
- IF( TRACE
- $ WRITE( NTRA, FMT
- $ TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
- $ BETA, LDC
- IF( REWI
- $ REWIND
- CALL
- $ AA, LDA, BB, LDB, BETA, CC, LDC
- IF( .NOT.OK
- WRITE( NOUT, FMT
- FATAL
- GO
- END
- ISAME( 1 )
- ISAME( 2 )
- ISAME( 3 )
- ISAME( 4 )
- ISAME( 5 )
- ISAME( 6 )
- ISAME( 7 )
- ISAME( 8 )
- ISAME( 9 )
- ISAME( 10 )
- ISAME( 11 )
- IF( NULL
- ISAME( 12 )
- ELSE
- ISAME( 12 )
- $ CC, LDC
- END
- ISAME( 13 )
- SAME
- DO
- SAME
- IF( .NOT.ISAME( I )
- $ WRITE( NOUT, FMT
- 40 CONTINUE
- IF( .NOT.SAME
- FATAL
- GO
- END
- IF( .NOT.NULL
- CALL
- $ ALPHA, A, NMAX, B, NMAX, BETA,
- $ C, NMAX, CT, G, CC, LDC, EPS,
- $ ERR, FATAL, NOUT, .TRUE. )
- ERRMAX
- IF( FATAL
- $ GO
- END
- 50 CONTINUE
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
- IF( ERRMAX.LT.THRESH
- WRITE( NOUT, FMT
- ELSE
- WRITE( NOUT, FMT
- END
- GO
- 120 CONTINUE
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- $ ALPHA, LDA, LDB, BETA, LDC
- 130 CONTINUE
- RETURN
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
- $ 'S)' )
- 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
- $ 'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
- $ 'ALLS)', /, F8.2,
- $ )
- 9996 FORMAT( , A6, )
- 9995 FORMAT( 1X, I6, , A6, , A1, , A1, ,
- $ 3( I3, ), , F4.1, , F4.1, , I3, , I3,
- $ , F4.1, , F4.1, , I3, )
- 9994 FORMAT( ,
- $ )
- *
- * End of ZCHK1.
- *
- END
- SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
- $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
- $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
- *
- * Tests ZHEMM and ZSYMM.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ) )
- DOUBLE PRECISION RZERO
- PARAMETER ( RZERO = 0.0D0 )
- * .. Scalar Arguments ..
- DOUBLE PRECISION EPS, THRESH
- INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
- LOGICAL FATAL, REWI, TRACE
- CHARACTER*6 SNAME
- * .. Array Arguments ..
- COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
- $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
- $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
- $ C( NMAX, NMAX ), CC( NMAX*NMAX ),
- $ CS( NMAX*NMAX ), CT( NMAX )
- DOUBLE PRECISION G( NMAX )
- INTEGER IDIM( NIDIM )
- * .. Local Scalars ..
- COMPLEX*16 ALPHA, ALS, BETA, BLS
- DOUBLE PRECISION ERR, ERRMAX
- INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
- $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
- $ NARGS, NC, NS
- LOGICAL CONJ, LEFT, NULL, RESET, SAME
- CHARACTER*1 SIDE, SIDES, UPLO, UPLOS
- CHARACTER*2 ICHS, ICHU
- * .. Local Arrays ..
- LOGICAL ISAME( 13 )
- * .. External Functions ..
- LOGICAL LZE, LZERES
- EXTERNAL LZE, LZERES
- * .. External Subroutines ..
- EXTERNAL ZHEMM, ZMAKE, ZMMCH, ZSYMM
- * .. Intrinsic Functions ..
- INTRINSIC MAX
- * .. Scalars in Common ..
- INTEGER INFOT, NOUTC
- LOGICAL LERR, OK
- * .. Common blocks ..
- COMMON /INFOC/INFOT, NOUTC, OK, LERR
- * .. Data statements ..
- DATA ICHS/'LR'/, ICHU/'UL'/
- * .. Executable Statements ..
- CONJ = SNAME( 2: 3 ).EQ.
- *
- NARGS = 12
- NC = 0
- RESET = .TRUE.
- ERRMAX = RZERO
- *
- DO 100 IM = 1, NIDIM
- M = IDIM( IM )
- *
- DO 90 IN = 1, NIDIM
- N = IDIM( IN )
- * Set LDC to 1 more than minimum value if room.
- LDC = M
- IF( LDC.LT.NMAX )
- $ LDC = LDC + 1
- * Skip tests if not enough room.
- IF( LDC.GT.NMAX )
- $ GO TO 90
- LCC = LDC*N
- NULL = N.LE.0.OR.M.LE.0
- * Set LDB to 1 more than minimum value if room.
- LDB = M
- IF( LDB.LT.NMAX )
- $ LDB = LDB + 1
- * Skip tests if not enough room.
- IF( LDB.GT.NMAX )
- $ GO TO 90
- LBB = LDB*N
- *
- * Generate the matrix B.
- *
- CALL ZMAKE( , , , M, N, B, NMAX, BB, LDB, RESET,
- $ ZERO )
- *
- DO 80 ICS = 1, 2
- SIDE = ICHS( ICS: ICS )
- LEFT = SIDE.EQ.
- *
- IF( LEFT )THEN
- NA = M
- ELSE
- NA = N
- END IF
- * Set LDA to 1 more than minimum value if room.
- LDA = NA
- IF( LDA.LT.NMAX )
- $ LDA = LDA + 1
- * Skip tests if not enough room.
- IF( LDA.GT.NMAX )
- $ GO TO 80
- LAA = LDA*NA
- *
- DO 70 ICU = 1, 2
- UPLO = ICHU( ICU: ICU )
- *
- * Generate the hermitian or symmetric matrix A.
- *
- CALL ZMAKE( SNAME( 2: 3 ), UPLO, , NA, NA, A, NMAX,
- $ AA, LDA, RESET, ZERO )
- *
- DO 60 IA = 1, NALF
- ALPHA = ALF( IA )
- *
- DO 50 IB = 1, NBET
- BETA = BET( IB )
- *
- * Generate the matrix C.
- *
- CALL ZMAKE( , , , M, N, C, NMAX, CC,
- $ LDC, RESET, ZERO )
- *
- NC = NC + 1
- *
- * Save every datum before calling the
- * subroutine.
- *
- SIDES = SIDE
- UPLOS = UPLO
- MS = M
- NS = N
- ALS = ALPHA
- DO 10 I = 1, LAA
- AS( I ) = AA( I )
- 10 CONTINUE
- LDAS = LDA
- DO 20 I = 1, LBB
- BS( I ) = BB( I )
- 20 CONTINUE
- LDBS = LDB
- BLS = BETA
- DO 30 I = 1, LCC
- CS( I ) = CC( I )
- 30 CONTINUE
- LDCS = LDC
- *
- * Call the subroutine.
- *
- IF( TRACE )
- $ WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
- $ UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
- IF( REWI )
- $ REWIND NTRA
- IF( CONJ )THEN
- CALL ZHEMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
- $ BB, LDB, BETA, CC, LDC )
- ELSE
- CALL ZSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
- $ BB, LDB, BETA, CC, LDC )
- END IF
- *
- * Check if error-exit was taken incorrectly.
- *
- IF( .NOT.OK )THEN
- WRITE( NOUT, FMT = 9994 )
- FATAL = .TRUE.
- GO TO 110
- END IF
- *
- * See what data changed inside subroutines.
- *
- ISAME( 1 ) = SIDES.EQ.SIDE
- ISAME( 2 ) = UPLOS.EQ.UPLO
- ISAME( 3 ) = MS.EQ.M
- ISAME( 4 ) = NS.EQ.N
- ISAME( 5 ) = ALS.EQ.ALPHA
- ISAME( 6 ) = LZE( AS, AA, LAA )
- ISAME( 7 ) = LDAS.EQ.LDA
- ISAME( 8 ) = LZE( BS, BB, LBB )
- ISAME( 9 ) = LDBS.EQ.LDB
- ISAME( 10 ) = BLS.EQ.BETA
- IF( NULL )THEN
- ISAME( 11 ) = LZE( CS, CC, LCC )
- ELSE
- ISAME( 11 ) = LZERES( , , M, N, CS,
- $ CC, LDC )
- END IF
- ISAME( 12 ) = LDCS.EQ.LDC
- *
- * If data was incorrectly changed, report and
- * return.
- *
- SAME = .TRUE.
- DO 40 I = 1, NARGS
- SAME = SAME.AND.ISAME( I )
- IF( .NOT.ISAME( I ) )
- $ WRITE( NOUT, FMT = 9998 )I
- 40 CONTINUE
- IF( .NOT.SAME )THEN
- FATAL = .TRUE.
- GO TO 110
- END IF
- *
- IF( .NOT.NULL )THEN
- *
- * Check the result.
- *
- IF( LEFT )THEN
- CALL ZMMCH( , , M, N, M, ALPHA, A,
- $ NMAX, B, NMAX, BETA, C, NMAX,
- $ CT, G, CC, LDC, EPS, ERR,
- $ FATAL, NOUT, .TRUE. )
- ELSE
- CALL ZMMCH( , , M, N, N, ALPHA, B,
- $ NMAX, A, NMAX, BETA, C, NMAX,
- $ CT, G, CC, LDC, EPS, ERR,
- $ FATAL, NOUT, .TRUE. )
- END IF
- ERRMAX = MAX( ERRMAX, ERR )
- * If got really bad answer, report and
- * return.
- IF( FATAL )
- $ GO TO 110
- END IF
- *
- 50 CONTINUE
- *
- 60 CONTINUE
- *
- 70 CONTINUE
- *
- 80 CONTINUE
- *
- 90 CONTINUE
- *
- 100 CONTINUE
- *
- * Report result.
- *
- IF( ERRMAX.LT.THRESH )THEN
- WRITE( NOUT, FMT = 9999 )SNAME, NC
- ELSE
- WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
- END IF
- GO TO 120
- *
- 110 CONTINUE
- WRITE( NOUT, FMT = 9996 )SNAME
- WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
- $ LDB, BETA, LDC
- *
- 120 CONTINUE
- RETURN
- *
- 9999 FORMAT( , A6, , I6, ,
- $ )
- 9998 FORMAT( , I2, ,
- $ )
- 9997 FORMAT( , A6, , I6, ,
- $ , /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
- $ ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
- $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
- $ ',', F4.1, '), C,', I3, ') .' )
- 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
- $ '******' )
- END
- SUBROUTINE
- $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
- $ B, BB, BS, CT, G, C
- COMPLEX*16 ZERO, ONE
- PARAMETER
- $ ONE
- DOUBLE
- PARAMETER
- DOUBLE
- INTEGER
- LOGICAL
- CHARACTER*6 SNAME
- COMPLEX*16 A( NMAX, NMAX
- $ AS( NMAX*NMAX
- $ BB( NMAX*NMAX
- $ C( NMAX, NMAX
- DOUBLE
- INTEGER
- COMPLEX*16 ALPHA, ALS
- DOUBLE
- INTEGER
- $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
- $ NS
- LOGICAL
- CHARACTER*1 DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
- $ UPLOS
- CHARACTER*2 ICHD, ICHS, ICHU
- CHARACTER*3 ICHT
- LOGICAL
- LOGICAL
- EXTERNAL
- EXTERNAL
- INTRINSIC
- INTEGER
- LOGICAL
- COMMON /INFOC/
- DATA ////////
- NARGS
- NC
- RESET
- ERRMAX
- DO
- DO
- C( I, J )
- 10 CONTINUE
- 20 CONTINUE
- DO
- M
- DO
- N
- LDB
- IF( LDB.LT.NMAX
- $ LDB
- IF( LDB.GT.NMAX
- $ GO
- LBB
- NULL
- DO
- SIDE
- LEFT
- IF( LEFT
- NA
- ELSE
- NA
- END
- LDA
- IF( LDA.LT.NMAX
- $ LDA
- IF( LDA.GT.NMAX
- $ GO
- LAA
- DO
- UPLO
- DO
- TRANSA
- DO
- DIAG
- DO
- ALPHA
- CALL
- $ NMAX, AA, LDA, RESET, ZERO
- CALL
- $ BB, LDB, RESET, ZERO
- NC
- SIDES
- UPLOS
- TRANAS
- DIAGS
- MS
- NS
- ALS
- DO
- AS( I )
- 30 CONTINUE
- LDAS
- DO
- BS( I )
- 40 CONTINUE
- LDBS
- IF( SNAME( 4: 5 ).EQ.'MM' )THEN
- IF( TRACE
- $ WRITE( NTRA, FMT
- $ SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
- $ LDA, LDB
- IF( REWI
- $ REWIND
- CALL
- $ N, ALPHA, AA, LDA, BB, LDB
- ELSE
- IF( TRACE
- $ WRITE( NTRA, FMT
- $ SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
- $ LDA, LDB
- IF( REWI
- $ REWIND
- CALL
- $ N, ALPHA, AA, LDA, BB, LDB
- END
- IF( .NOT.OK
- WRITE( NOUT, FMT
- FATAL
- GO
- END
- ISAME( 1 )
- ISAME( 2 )
- ISAME( 3 )
- ISAME( 4 )
- ISAME( 5 )
- ISAME( 6 )
- ISAME( 7 )
- ISAME( 8 )
- ISAME( 9 )
- IF( NULL
- ISAME( 10 )
- ELSE
- ISAME( 10 )
- $ BB, LDB
- END
- ISAME( 11 )
- SAME
- DO
- SAME
- IF( .NOT.ISAME( I )
- $ WRITE( NOUT, FMT
- 50 CONTINUE
- IF( .NOT.SAME
- FATAL
- GO
- END
- IF( .NOT.NULL
- IF( SNAME( 4: 5 ).EQ.'MM' )THEN
- IF( LEFT
- CALL
- $ ALPHA, A, NMAX, B, NMAX,
- $ ZERO, C, NMAX, CT, G,
- $ BB, LDB, EPS, ERR,
- $ FATAL, NOUT, .TRUE. )
- ELSE
- CALL
- $ ALPHA, B, NMAX, A, NMAX,
- $ ZERO, C, NMAX, CT, G,
- $ BB, LDB, EPS, ERR,
- $ FATAL, NOUT, .TRUE. )
- END
- ELSE
- DO
- DO
- C( I, J )
- $ LDB
- BB( I
- $ B( I, J
- 60 CONTINUE
- 70 CONTINUE
- IF( LEFT
- CALL
- $ ONE, A, NMAX, C, NMAX,
- $ ZERO, B, NMAX, CT, G,
- $ BB, LDB, EPS, ERR,
- $ FATAL, NOUT, .FALSE. )
- ELSE
- CALL
- $ ONE, C, NMAX, A, NMAX,
- $ ZERO, B, NMAX, CT, G,
- $ BB, LDB, EPS, ERR,
- $ FATAL, NOUT, .FALSE. )
- END
- END
- ERRMAX
- IF( FATAL
- $ GO
- END
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
- IF( ERRMAX.LT.THRESH
- WRITE( NOUT, FMT
- ELSE
- WRITE( NOUT, FMT
- END
- GO
- 150 CONTINUE
- WRITE( NOUT, FMT
- WRITE( NOUT, FMT
- $ N, ALPHA, LDA, LDB
- 160 CONTINUE
- RETURN
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
- $ 'S)' )
- 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
- $ 'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
- $ 'ALLS)', /, F8.2,
- $ )
- 9996 FORMAT( , A6, )
- 9995 FORMAT( 1X, I6, , A6, , 4( , A1, ), 2( I3, ),
- $ , F4.1, , F4.1, , I3, , I3, ,
- $ )
- 9994 FORMAT( ,
- $ )
- *
- * End of ZCHK3.
- *
- END
- SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
- $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
- $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
- *
- * Tests ZHERK and ZSYRK.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ) )
- DOUBLE PRECISION RONE, RZERO
- PARAMETER ( RONE = 1.0D0, RZERO = 0.0D0 )
- * .. Scalar Arguments ..
- DOUBLE PRECISION EPS, THRESH
- INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
- LOGICAL FATAL, REWI, TRACE
- CHARACTER*6 SNAME
- * .. Array Arguments ..
- COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
- $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
- $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
- $ C( NMAX, NMAX ), CC( NMAX*NMAX ),
- $ CS( NMAX*NMAX ), CT( NMAX )
- DOUBLE PRECISION G( NMAX )
- INTEGER IDIM( NIDIM )
- * .. Local Scalars ..
- COMPLEX*16 ALPHA, ALS, BETA, BETS
- DOUBLE PRECISION ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
- INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
- $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
- $ NARGS, NC, NS
- LOGICAL CONJ, NULL, RESET, SAME, TRAN, UPPER
- CHARACTER*1 TRANS, TRANSS, TRANST, UPLO, UPLOS
- CHARACTER*2 ICHT, ICHU
- * .. Local Arrays ..
- LOGICAL ISAME( 13 )
- * .. External Functions ..
- LOGICAL LZE, LZERES
- EXTERNAL LZE, LZERES
- * .. External Subroutines ..
- EXTERNAL ZHERK, ZMAKE, ZMMCH, ZSYRK
- * .. Intrinsic Functions ..
- INTRINSIC DCMPLX, MAX, DBLE
- * .. Scalars in Common ..
- INTEGER INFOT, NOUTC
- LOGICAL LERR, OK
- * .. Common blocks ..
- COMMON /INFOC/INFOT, NOUTC, OK, LERR
- * .. Data statements ..
- DATA ICHT/'NC'/, ICHU/'UL'/
- * .. Executable Statements ..
- CONJ = SNAME( 2: 3 ).EQ.
- *
- NARGS = 10
- NC = 0
- RESET = .TRUE.
- ERRMAX = RZERO
- *
- DO 100 IN = 1, NIDIM
- N = IDIM( IN )
- * Set LDC to 1 more than minimum value if room.
- LDC = N
- IF( LDC.LT.NMAX )
- $ LDC = LDC + 1
- * Skip tests if not enough room.
- IF( LDC.GT.NMAX )
- $ GO TO 100
- LCC = LDC*N
- *
- DO 90 IK = 1, NIDIM
- K = IDIM( IK )
- *
- DO 80 ICT = 1, 2
- TRANS = ICHT( ICT: ICT )
- TRAN = TRANS.EQ.
- IF( TRAN.AND..NOT.CONJ )
- $ TRANS =
- IF( TRAN )THEN
- MA = K
- NA = N
- ELSE
- MA = N
- NA = K
- END IF
- * Set LDA to 1 more than minimum value if room.
- LDA = MA
- IF( LDA.LT.NMAX )
- $ LDA = LDA + 1
- * Skip tests if not enough room.
- IF( LDA.GT.NMAX )
- $ GO TO 80
- LAA = LDA*NA
- *
- * Generate the matrix A.
- *
- CALL ZMAKE( , , , MA, NA, A, NMAX, AA, LDA,
- $ RESET, ZERO )
- *
- DO 70 ICU = 1, 2
- UPLO = ICHU( ICU: ICU )
- UPPER = UPLO.EQ.
- *
- DO 60 IA = 1, NALF
- ALPHA = ALF( IA )
- IF( CONJ )THEN
- RALPHA = DBLE( ALPHA )
- ALPHA = DCMPLX( RALPHA, RZERO )
- END IF
- *
- DO 50 IB = 1, NBET
- BETA = BET( IB )
- IF( CONJ )THEN
- RBETA = DBLE( BETA )
- BETA = DCMPLX( RBETA, RZERO )
- END IF
- NULL = N.LE.0
- IF( CONJ )
- $ NULL = NULL.OR.( ( K.LE.0.OR.RALPHA.EQ.
- $ RZERO ).AND.RBETA.EQ.RONE )
- *
- * Generate the matrix C.
- *
- CALL ZMAKE( SNAME( 2: 3 ), UPLO, , N, N, C,
- $ NMAX, CC, LDC, RESET, ZERO )
- *
- NC = NC + 1
- *
- * Save every datum before calling the subroutine.
- *
- UPLOS = UPLO
- TRANSS = TRANS
- NS = N
- KS = K
- IF( CONJ )THEN
- RALS = RALPHA
- ELSE
- ALS = ALPHA
- END IF
- DO 10 I = 1, LAA
- AS( I ) = AA( I )
- 10 CONTINUE
- LDAS = LDA
- IF( CONJ )THEN
- RBETS = RBETA
- ELSE
- BETS = BETA
- END IF
- DO 20 I = 1, LCC
- CS( I ) = CC( I )
- 20 CONTINUE
- LDCS = LDC
- *
- * Call the subroutine.
- *
- IF( CONJ )THEN
- IF( TRACE )
- $ WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
- $ TRANS, N, K, RALPHA, LDA, RBETA, LDC
- IF( REWI )
- $ REWIND NTRA
- CALL ZHERK( UPLO, TRANS, N, K, RALPHA, AA,
- $ LDA, RBETA, CC, LDC )
- ELSE
- IF( TRACE )
- $ WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
- $ TRANS, N, K, ALPHA, LDA, BETA, LDC
- IF( REWI )
- $ REWIND NTRA
- CALL ZSYRK( UPLO, TRANS, N, K, ALPHA, AA,
- $ LDA, BETA, CC, LDC )
- END IF
- *
- * Check if error-exit was taken incorrectly.
- *
- IF( .NOT.OK )THEN
- WRITE( NOUT, FMT = 9992 )
- FATAL = .TRUE.
- GO TO 120
- END IF
- *
- * See what data changed inside subroutines.
- *
- ISAME( 1 ) = UPLOS.EQ.UPLO
- ISAME( 2 ) = TRANSS.EQ.TRANS
- ISAME( 3 ) = NS.EQ.N
- ISAME( 4 ) = KS.EQ.K
- IF( CONJ )THEN
- ISAME( 5 ) = RALS.EQ.RALPHA
- ELSE
- ISAME( 5 ) = ALS.EQ.ALPHA
- END IF
- ISAME( 6 ) = LZE( AS, AA, LAA )
- ISAME( 7 ) = LDAS.EQ.LDA
- IF( CONJ )THEN
- ISAME( 8 ) = RBETS.EQ.RBETA
- ELSE
- ISAME( 8 ) = BETS.EQ.BETA
- END IF
- IF( NULL )THEN
- ISAME( 9 ) = LZE( CS, CC, LCC )
- ELSE
- ISAME( 9 ) = LZERES( SNAME( 2: 3 ), UPLO, N,
- $ N, CS, CC, LDC )
- END IF
- ISAME( 10 ) = LDCS.EQ.LDC
- *
- * If data was incorrectly changed, report and
- * return.
- *
- SAME = .TRUE.
- DO 30 I = 1, NARGS
- SAME = SAME.AND.ISAME( I )
- IF( .NOT.ISAME( I ) )
- $ WRITE( NOUT, FMT = 9998 )I
- 30 CONTINUE
- IF( .NOT.SAME )THEN
- FATAL = .TRUE.
- GO TO 120
- END IF
- *
- IF( .NOT.NULL )THEN
- *
- * Check the result column by column.
- *
- IF( CONJ )THEN
- TRANST =
- ELSE
- TRANST =
- END IF
- JC = 1
- DO 40 J = 1, N
- IF( UPPER )THEN
- JJ = 1
- LJ = J
- ELSE
- JJ = J
- LJ = N - J + 1
- END IF
- IF( TRAN )THEN
- CALL ZMMCH( TRANST, , LJ, 1, K,
- $ ALPHA, A( 1, JJ ), NMAX,
- $ A( 1, J ), NMAX, BETA,
- $ C( JJ, J ), NMAX, CT, G,
- $ CC( JC ), LDC, EPS, ERR,
- $ FATAL, NOUT, .TRUE. )
- ELSE
- CALL ZMMCH( , TRANST, LJ, 1, K,
- $ ALPHA, A( JJ, 1 ), NMAX,
- $ A( J, 1 ), NMAX, BETA,
- $ C( JJ, J ), NMAX, CT, G,
- $ CC( JC ), LDC, EPS, ERR,
- $ FATAL, NOUT, .TRUE. )
- END IF
- IF( UPPER )THEN
- JC = JC + LDC
- ELSE
- JC = JC + LDC + 1
- END IF
- ERRMAX = MAX( ERRMAX, ERR )
- * If got really bad answer, report and
- * return.
- IF( FATAL )
- $ GO TO 110
- 40 CONTINUE
- END IF
- *
- 50 CONTINUE
- *
- 60 CONTINUE
- *
- 70 CONTINUE
- *
- 80 CONTINUE
- *
- 90 CONTINUE
- *
- 100 CONTINUE
- *
- * Report result.
- *
- IF( ERRMAX.LT.THRESH )THEN
- WRITE( NOUT, FMT = 9999 )SNAME, NC
- ELSE
- WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
- END IF
- GO TO 130
- *
- 110 CONTINUE
- IF( N.GT.1 )
- $ WRITE( NOUT, FMT = 9995 )J
- *
- 120 CONTINUE
- WRITE( NOUT, FMT = 9996 )SNAME
- IF( CONJ )THEN
- WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, RALPHA,
- $ LDA, RBETA, LDC
- ELSE
- WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
- $ LDA, BETA, LDC
- END IF
- *
- 130 CONTINUE
- RETURN
- *
- 9999 FORMAT( , A6, , I6, ,
- $ )
- 9998 FORMAT( , I2, ,
- $ )
- 9997 FORMAT( , A6, , I6, ,
- $ , /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
- $ ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
- $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ',
- $ ' .' )
- 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
- $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
- $ '), C,', I3, ') .' )
- 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
- $ '******' )
- END
- SUBROUTINE
- $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
- $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W
- COMPLEX*16 ZERO, ONE
- PARAMETER
- $ ONE
- DOUBLE
- PARAMETER
- DOUBLE
- INTEGER
- LOGICAL
- CHARACTER*6 SNAME
- COMPLEX*16 AA( NMAX*NMAX
- $ ALF( NALF
- $ BET( NBET
- $ CC( NMAX*NMAX
- $ W( 2*NMAX
- DOUBLE
- INTEGER
- COMPLEX*16 ALPHA, ALS, BETA, BETS
- DOUBLE
- INTEGER
- $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
- $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
- LOGICAL
- CHARACTER*1 TRANS, TRANSS, TRANST, UPLO, UPLOS
- CHARACTER*2 ICHT, ICHU
- LOGICAL
- LOGICAL
- EXTERNAL
- EXTERNAL
- INTRINSIC
- INTEGER
- LOGICAL
- COMMON /INFOC/
- DATA ////
- CONJ
- NARGS
- NC
- RESET
- ERRMAX
- DO
- N
- LDC
- IF( LDC.LT.NMAX
- $ LDC
- IF( LDC.GT.NMAX
- $ GO
- LCC
- DO
- K
- DO
- TRANS
- TRAN
- IF( TRAN.AND..NOT.CONJ
- $ TRANS
- IF( TRAN
- MA
- NA
- ELSE
- MA
- NA
- END
- LDA
- IF( LDA.LT.NMAX
- $ LDA
- IF( LDA.GT.NMAX
- $ GO
- LAA
- IF( TRAN
- CALL
- $ LDA, RESET, ZERO
- ELSE
- CALL
- $ RESET, ZERO
- END
- LDB
- LBB
- IF( TRAN
- CALL
- $ 2*NMAX, BB, LDB, RESET, ZERO
- ELSE
- CALL
- $ NMAX, BB, LDB, RESET, ZERO
- END
- DO
- UPLO
- UPPER
- DO
- ALPHA
- DO
- BETA
- IF( CONJ
- RBETA
- BETA
- END
- NULL
- IF( CONJ
- $ NULL
- $ ZERO
- CALL
- $ NMAX, CC, LDC, RESET, ZERO
- NC
- UPLOS
- TRANSS
- NS
- KS
- ALS
- DO
- AS( I )
- 10 CONTINUE
- LDAS
- DO
- BS( I )
- 20 CONTINUE
- LDBS
- IF( CONJ
- RBETS
- ELSE
- BETS
- END
- DO
- CS( I )
- 30 CONTINUE
- LDCS
- IF( CONJ
- IF( TRACE
- $ WRITE( NTRA, FMT
- $ TRANS, N, K, ALPHA, LDA, LDB, RBETA, LDC
- IF( REWI
- $ REWIND
- CALL
- $ LDA, BB, LDB, RBETA, CC, LDC
- ELSE
- IF( TRACE
- $ WRITE( NTRA, FMT
- $ TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
- IF( REWI
- $ REWIND
- CALL
- $ LDA, BB, LDB, BETA, CC, LDC
- END
- IF( .NOT.OK
- WRITE( NOUT, FMT
- FATAL
- GO
- END
- ISAME( 1 )
- ISAME( 2 )
- ISAME( 3 )
- ISAME( 4 )
- ISAME( 5 )
- ISAME( 6 )
- ISAME( 7 )
- ISAME( 8 )
- ISAME( 9 )
- IF( CONJ
- ISAME( 10 )
- ELSE
- ISAME( 10 )
- END
- IF( NULL
- ISAME( 11 )
- ELSE
- ISAME( 11 )
- $ CC, LDC
- END
- ISAME( 12 )
- SAME
- DO
- SAME
- IF( .NOT.ISAME( I )
- $ WRITE( NOUT, FMT
- 40 CONTINUE
- IF( .NOT.SAME
- FATAL
- GO
- END
- IF( .NOT.NULL
- IF( CONJ
- TRANST
- ELSE
- TRANST
- END
- JJAB
- JC
- DO
- IF( UPPER
- JJ
- LJ
- ELSE
- JJ
- LJ
- END
- IF( TRAN
- DO
- W( I )
- $ NMAX
- IF( CONJ
- W( K
- $ AB( ( J
- $ NMAX
- ELSE
- W( K
- $ AB( ( J
- $ NMAX
- END
- 50 CONTINUE
- CALL
- $ ONE, AB( JJAB
- $ 2*NMAX, BETA, C( JJ, J
- $ NMAX, CT, G, CC( JC
- $ EPS, ERR, FATAL, NOUT,
- $ .TRUE. )
- ELSE
- DO
- IF( CONJ
- W( I )
- $ I
- W( K
- $ AB( ( I
- $ J
- ELSE
- W( I )
- $ NMAX
- W( K
- $ AB( ( I
- $ J
- END
- 60 CONTINUE
- CALL
- $ AB( JJ
- $ BETA, C( JJ, J
- $ G, CC( JC
- $ FATAL, NOUT, .TRUE. )
- END
- IF( UPPER
- JC
- ELSE
- JC
- IF( TRAN
- $ JJAB
- END
- ERRMAX
- IF( FATAL
- $ GO
- 70 CONTINUE
- END
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
- 120 CONTINUE
- 130 CONTINUE
- IF( ERRMAX.LT.THRESH
- WRITE( NOUT, FMT
- ELSE
- WRITE( NOUT, FMT
- END
- GO
- 140 CONTINUE
- IF( N.GT.1 )
- $ WRITE( NOUT, FMT
- 150 CONTINUE
- WRITE( NOUT, FMT
- IF( CONJ
- WRITE( NOUT, FMT
- $ LDA, LDB, RBETA, LDC
- ELSE
- WRITE( NOUT, FMT
- $ LDA, LDB, BETA, LDC
- END
- 160 CONTINUE
- RETURN
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
- $ 'S)' )
- 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
- $ 'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
- $ 'ALLS)', /, F8.2,
- $ )
- 9996 FORMAT( , A6, )
- 9995 FORMAT( , I3 )
- 9994 FORMAT( 1X, I6, , A6, , 2( , A1, ), 2( I3, ),
- $ , F4.1, , F4.1, , I3, , I3, , F4.1,
- $ , I3, )
- 9993 FORMAT( 1X, I6, , A6, , 2( , A1, ), 2( I3, ),
- $ , F4.1, , F4.1, , I3, , I3, , F4.1,
- $ , F4.1, , I3, )
- 9992 FORMAT( ,
- $ )
- *
- * End of ZCHK5.
- *
- END
- SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT )
- *
- * Tests the error exits from the Level 3 Blas.
- * Requires a special version of the error-handling routine XERBLA.
- * A, B and C should not need to be defined.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * 3-19-92: Initialize ALPHA, BETA, RALPHA, and RBETA (eca)
- * 3-19-92: Fix argument 12 in calls to ZSYMM and ZHEMM
- * with INFOT = 9 (eca)
- * 10-9-00: Declared INTRINSIC DCMPLX (susan)
- *
- * .. Scalar Arguments ..
- INTEGER ISNUM, NOUT
- CHARACTER*6 SRNAMT
- * .. Scalars in Common ..
- INTEGER INFOT, NOUTC
- LOGICAL LERR, OK
- * .. Parameters ..
- REAL ONE, TWO
- PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 )
- * .. Local Scalars ..
- COMPLEX*16 ALPHA, BETA
- DOUBLE PRECISION RALPHA, RBETA
- * .. Local Arrays ..
- COMPLEX*16 A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
- * .. External Subroutines ..
- EXTERNAL ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
- $ ZSYR2K, ZSYRK, ZTRMM, ZTRSM
- * .. Intrinsic Functions ..
- INTRINSIC DCMPLX
- * .. Common blocks ..
- COMMON /INFOC/INFOT, NOUTC, OK, LERR
- * .. Executable Statements ..
- * OK is set to .FALSE. by the special version of XERBLA or by CHKXER
- * if anything is wrong.
- OK = .TRUE.
- * LERR is set to .TRUE. by the special version of XERBLA each time
- * it is called, and is then tested and re-set by CHKXER.
- LERR = .FALSE.
- *
- * Initialize ALPHA, BETA, RALPHA, and RBETA.
- *
- ALPHA = DCMPLX( ONE, -ONE )
- BETA = DCMPLX( TWO, -TWO )
- RALPHA = ONE
- RBETA = TWO
- *
- GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
- $ 90 )ISNUM
- 10 INFOT = 1
- CALL ZGEMM( , , 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 1
- CALL ZGEMM( , , 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 1
- CALL ZGEMM( , , 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZGEMM( , , 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZGEMM( , , 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZGEMM( , , 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZGEMM( , , -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZGEMM( , , 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZGEMM( , , 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 8
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZGEMM( , , 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 13
- CALL ZGEMM( , , 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 20 INFOT = 1
- CALL ZHEMM( , , 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZHEMM( , , 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHEMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHEMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHEMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHEMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHEMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHEMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHEMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHEMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHEMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHEMM( , , 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHEMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHEMM( , , 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHEMM( , , 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHEMM( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHEMM( , , 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHEMM( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHEMM( , , 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHEMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHEMM( , , 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHEMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 30 INFOT = 1
- CALL ZSYMM( , , 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZSYMM( , , 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYMM( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYMM( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYMM( , , 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYMM( , , 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYMM( , , 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYMM( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYMM( , , 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYMM( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYMM( , , 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYMM( , , 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYMM( , , 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 40 INFOT = 1
- CALL ZTRMM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZTRMM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZTRMM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZTRMM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRMM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRMM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRMM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRMM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 50 INFOT = 1
- CALL ZTRSM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZTRSM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZTRSM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZTRSM( , , , , 0, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 5
- CALL ZTRSM( , , , , -1, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 6
- CALL ZTRSM( , , , , 0, -1, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZTRSM( , , , , 0, 2, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 2, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 11
- CALL ZTRSM( , , , , 2, 0, ALPHA, A, 1, B, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 60 INFOT = 1
- CALL ZHERK( , , 0, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZHERK( , , 0, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHERK( , , -1, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHERK( , , -1, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHERK( , , -1, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHERK( , , -1, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHERK( , , 0, -1, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHERK( , , 0, -1, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHERK( , , 0, -1, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHERK( , , 0, -1, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHERK( , , 2, 0, RALPHA, A, 1, RBETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHERK( , , 0, 2, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHERK( , , 2, 0, RALPHA, A, 1, RBETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHERK( , , 0, 2, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZHERK( , , 2, 0, RALPHA, A, 2, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZHERK( , , 2, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZHERK( , , 2, 0, RALPHA, A, 2, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZHERK( , , 2, 0, RALPHA, A, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 70 INFOT = 1
- CALL ZSYRK( , , 0, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZSYRK( , , 0, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYRK( , , -1, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYRK( , , -1, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYRK( , , -1, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYRK( , , -1, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYRK( , , 0, -1, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYRK( , , 0, -1, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYRK( , , 0, -1, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYRK( , , 0, -1, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYRK( , , 2, 0, ALPHA, A, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYRK( , , 0, 2, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYRK( , , 2, 0, ALPHA, A, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYRK( , , 0, 2, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZSYRK( , , 2, 0, ALPHA, A, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZSYRK( , , 2, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZSYRK( , , 2, 0, ALPHA, A, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 10
- CALL ZSYRK( , , 2, 0, ALPHA, A, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 80 INFOT = 1
- CALL ZHER2K( , , 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZHER2K( , , 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHER2K( , , -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHER2K( , , -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHER2K( , , -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZHER2K( , , -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHER2K( , , 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHER2K( , , 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHER2K( , , 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZHER2K( , , 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHER2K( , , 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHER2K( , , 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHER2K( , , 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZHER2K( , , 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHER2K( , , 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHER2K( , , 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHER2K( , , 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZHER2K( , , 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHER2K( , , 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHER2K( , , 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHER2K( , , 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZHER2K( , , 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- GO TO 100
- 90 INFOT = 1
- CALL ZSYR2K( , , 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 2
- CALL ZSYR2K( , , 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYR2K( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYR2K( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYR2K( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 3
- CALL ZSYR2K( , , -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYR2K( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYR2K( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYR2K( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 4
- CALL ZSYR2K( , , 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYR2K( , , 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 7
- CALL ZSYR2K( , , 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYR2K( , , 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 9
- CALL ZSYR2K( , , 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- INFOT = 12
- CALL ZSYR2K( , , 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
- CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- *
- 100 IF( OK )THEN
- WRITE( NOUT, FMT = 9999 )SRNAMT
- ELSE
- WRITE( NOUT, FMT = 9998 )SRNAMT
- END IF
- RETURN
- *
- 9999 FORMAT( , A6, )
- 9998 FORMAT( , A6, ,
- $ )
- *
- * End of ZCHKE.
- *
- END
- SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
- $ TRANSL )
- *
- * Generates values for an M by N matrix A.
- * Stores the values in the array AA in the data structure required
- * by the routine, with unwanted elements set to rogue value.
- *
- * TYPE is , , or .
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Parameters ..
- COMPLEX*16 ZERO, ONE
- PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ),
- $ ONE = ( 1.0D0, 0.0D0 ) )
- COMPLEX*16 ROGUE
- PARAMETER ( ROGUE = ( -1.0D10, 1.0D10 ) )
- DOUBLE PRECISION RZERO
- PARAMETER ( RZERO = 0.0D0 )
- DOUBLE PRECISION RROGUE
- PARAMETER ( RROGUE = -1.0D10 )
- * .. Scalar Arguments ..
- COMPLEX*16 TRANSL
- INTEGER LDA, M, N, NMAX
- LOGICAL RESET
- CHARACTER*1 DIAG, UPLO
- CHARACTER*2 TYPE
- * .. Array Arguments ..
- COMPLEX*16 A( NMAX, * ), AA( * )
- * .. Local Scalars ..
- INTEGER I, IBEG, IEND, J, JJ
- LOGICAL GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
- * .. External Functions ..
- COMPLEX*16 ZBEG
- EXTERNAL ZBEG
- * .. Intrinsic Functions ..
- INTRINSIC DCMPLX, DCONJG, DBLE
- * .. Executable Statements ..
- GEN = TYPE.EQ.
- HER = TYPE.EQ.
- SYM = TYPE.EQ.
- TRI = TYPE.EQ.
- UPPER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.
- LOWER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.
- UNIT = TRI.AND.DIAG.EQ.
- *
- * Generate data in array A.
- *
- DO 20 J = 1, N
- DO 10 I = 1, M
- IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
- $ THEN
- A( I, J ) = ZBEG( RESET ) + TRANSL
- IF( I.NE.J )THEN
- * Set some elements to zero
- IF( N.GT.3.AND.J.EQ.N/2 )
- $ A( I, J )
- IF( HER
- A( J, I )
- ELSE
- A( J, I )
- ELSE
- A( J, I )
- END
- END
- END
- 10 CONTINUE
- IF( HER
- $ A( J, J )
- IF( TRI
- $ A( J, J )
- IF( UNIT
- $ A( J, J )
- 20 CONTINUE
- IF( TYPE.EQ.'GE' )THEN
- DO
- DO
- AA( I
- 30 CONTINUE
- DO
- AA( I
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO
- IF( UPPER
- IBEG
- IF( UNIT
- IEND
- ELSE
- IEND
- END
- ELSE
- IF( UNIT
- IBEG
- ELSE
- IBEG
- END
- IEND
- END
- DO
- AA( I
- 60 CONTINUE
- DO
- AA( I
- 70 CONTINUE
- DO
- AA( I
- 80 CONTINUE
- IF( HER
- JJ
- AA( JJ )
- END
- 90 CONTINUE
- END
- RETURN
- END
- SUBROUTINE
- $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
- $ NOUT, MV
- COMPLEX*16 ZERO
- PARAMETER
- DOUBLE
- PARAMETER
- COMPLEX*16 ALPHA, BETA
- DOUBLE
- INTEGER
- LOGICAL
- CHARACTER*1 TRANSA, TRANSB
- COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ CC( LDCC, * ), CT( * )
- DOUBLE
- COMPLEX*16 CL
- DOUBLE
- INTEGER
- LOGICAL
- INTRINSIC
- DOUBLE
- ABS1( CL )
- TRANA
- TRANB
- CTRANA
- CTRANB
- DO
- DO
- CT( I )
- G( I )
- 10 CONTINUE
- IF( .NOT.TRANA.AND..NOT.TRANB
- DO
- DO
- CT( I )
- G( I )
- 20 CONTINUE
- 30 CONTINUE
- ELSE
- IF( CTRANA
- DO
- DO
- CT( I )
- G( I )
- $ ABS1( B( K, J )
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO
- DO
- CT( I )
- G( I )
- $ ABS1( B( K, J )
- 60 CONTINUE
- 70 CONTINUE
- END
- ELSE
- IF( CTRANB
- DO
- DO
- CT( I )
- G( I )
- $ ABS1( B( J, K )
- 80 CONTINUE
- 90 CONTINUE
- ELSE
- DO
- DO
- CT( I )
- G( I )
- $ ABS1( B( J, K )
- 100 CONTINUE
- 110 CONTINUE
- END
- ELSE
- IF( CTRANA
- IF( CTRANB
- DO
- DO
- CT( I )
- $ DCONJG( B( J, K )
- G( I )
- $ ABS1( B( J, K )
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO
- DO
- CT( I )
- $ B( J, K
- G( I )
- $ ABS1( B( J, K )
- 140 CONTINUE
- 150 CONTINUE
- END
- ELSE
- IF( CTRANB
- DO
- DO
- CT( I )
- $ DCONJG( B( J, K )
- G( I )
- $ ABS1( B( J, K )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO
- DO
- CT( I )
- G( I )
- $ ABS1( B( J, K )
- 180 CONTINUE
- 190 CONTINUE
- END
- END
- END
- DO
- CT( I )
- G( I )
- $ ABS1( BETA
- 200 CONTINUE
- ERR
- DO
- ERRI /EPS
- IF( G( I ).NE.RZERO )
- $ ERRI = ERRI/
- ERR
- IF( ERR*SQRT( EPS
- $ GO
- 210 CONTINUE
- 220 CONTINUE
- GO
- 230 FATAL
- WRITE( NOUT, FMT
- DO
- IF( MV
- WRITE( NOUT, FMT
- ELSE
- WRITE( NOUT, FMT
- END
- 240 CONTINUE
- IF( N.GT.1 )
- $ WRITE( NOUT, FMT
- 250 CONTINUE
- RETURN
- 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
- $ 'F ACCURATE *******', /,
- $ )
- 9998 FORMAT( 1X, I7, 2( , G15.6, , G15.6, ) )
- 9997 FORMAT( , I3 )
- *
- * End of ZMMCH.
- *
- END
- LOGICAL FUNCTION LZE( RI, RJ, LR )
- *
- * Tests if two arrays are identical.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Scalar Arguments ..
- INTEGER LR
- * .. Array Arguments ..
- COMPLEX*16 RI( * ), RJ( * )
- * .. Local Scalars ..
- INTEGER I
- * .. Executable Statements ..
- DO 10 I = 1, LR
- IF( RI( I ).NE.RJ( I ) )
- $ GO TO 20
- 10 CONTINUE
- LZE = .TRUE.
- GO TO 30
- 20 CONTINUE
- LZE = .FALSE.
- 30 RETURN
- *
- * End of LZE.
- *
- END
- LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA )
- *
- * Tests if selected elements in two arrays are equal.
- *
- * TYPE is or or .
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Scalar Arguments ..
- INTEGER LDA, M, N
- CHARACTER*1 UPLO
- CHARACTER*2 TYPE
- * .. Array Arguments ..
- COMPLEX*16 AA( LDA, * ), AS( LDA, * )
- * .. Local Scalars ..
- INTEGER I, IBEG, IEND, J
- LOGICAL UPPER
- * .. Executable Statements ..
- UPPER = UPLO.EQ.
- IF( TYPE.EQ. )THEN
- DO 20 J = 1, N
- DO 10 I = M + 1, LDA
- IF( AA( I, J ).NE.AS( I, J ) )
- $ GO TO 70
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( TYPE.EQ..OR.TYPE.EQ. )THEN
- DO 50 J = 1, N
- IF( UPPER )THEN
- IBEG = 1
- IEND = J
- ELSE
- IBEG = J
- IEND = N
- END IF
- DO 30 I = 1, IBEG - 1
- IF( AA( I, J ).NE.AS( I, J ) )
- $ GO TO 70
- 30 CONTINUE
- DO 40 I = IEND + 1, LDA
- IF( AA( I, J ).NE.AS( I, J ) )
- $ GO TO 70
- 40 CONTINUE
- 50 CONTINUE
- END IF
- *
- LZERES = .TRUE.
- GO TO 80
- 70 CONTINUE
- LZERES = .FALSE.
- 80 RETURN
- *
- * End of LZERES.
- *
- END
- COMPLEX*16 FUNCTION ZBEG( RESET )
- *
- * Generates complex numbers as pairs of random numbers uniformly
- * distributed between -0.5 and 0.5.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Scalar Arguments ..
- LOGICAL RESET
- * .. Local Scalars ..
- INTEGER I, IC, J, MI, MJ
- * .. Save statement ..
- SAVE I, IC, J, MI, MJ
- * .. Intrinsic Functions ..
- INTRINSIC DCMPLX
- * .. Executable Statements ..
- IF( RESET )THEN
- * Initialize local variables.
- MI = 891
- MJ = 457
- I = 7
- J = 7
- IC = 0
- RESET = .FALSE.
- END IF
- *
- * The sequence of values of I or J is bounded between 1 and 999.
- * If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
- * If initial I or J = 4 or 8, the period will be 25.
- * If initial I or J = 5, the period will be 10.
- * IC is used to break up the period by skipping 1 value of I or J
- * in 6.
- *
- IC = IC + 1
- 10 I = I*MI
- J = J*MJ
- I = I - 1000*( I/1000 )
- J /1000 )
- IF( IC.GE.5 )THEN
- IC = 0
- GO TO 10
- END IF
- ZBEG = DCMPLX( ( I - 500 )//1001.0D0 )
- RETURN
- *
- * End of ZBEG.
- *
- END
- DOUBLE PRECISION FUNCTION DDIFF( X, Y )
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Scalar Arguments ..
- DOUBLE PRECISION X, Y
- * .. Executable Statements ..
- DDIFF = X - Y
- RETURN
- *
- * End of DDIFF.
- *
- END
- SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
- *
- * Tests whether XERBLA has detected an error when it should.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Scalar Arguments ..
- INTEGER INFOT, NOUT
- LOGICAL LERR, OK
- CHARACTER*6 SRNAMT
- * .. Executable Statements ..
- IF( .NOT.LERR )THEN
- WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
- OK = .FALSE.
- END IF
- LERR = .FALSE.
- RETURN
- *
- 9999 FORMAT( , I2, ,
- $ , A6, )
- *
- * End of CHKXER.
- *
- END
- SUBROUTINE XERBLA( SRNAME, INFO )
- *
- * This is a special version of XERBLA to be used only as part of
- * the test program for testing error exits from the Level 3 BLAS
- * routines.
- *
- * XERBLA is an error handler for the Level 3 BLAS routines.
- *
- * It is called by the Level 3 BLAS routines if an input parameter is
- * invalid.
- *
- * Auxiliary routine for test program for Level 3 Blas.
- *
- * -- Written on 8-February-1989.
- * Jack Dongarra, Argonne National Laboratory.
- * Iain Duff, AERE Harwell.
- * Jeremy Du Croz, Numerical Algorithms Group Ltd.
- * Sven Hammarling, Numerical Algorithms Group Ltd.
- *
- * .. Scalar Arguments ..
- INTEGER INFO
- CHARACTER*6 SRNAME
- * .. Scalars in Common ..
- INTEGER INFOT, NOUT
- LOGICAL LERR, OK
- CHARACTER*6 SRNAMT
- * .. Common blocks ..
- COMMON //INFOT, NOUT, OK, LERR
- COMMON //SRNAMT
- * .. Executable Statements ..
- LERR = .TRUE.
- IF( INFO.NE.INFOT )THEN
- IF( INFOT.NE.0 )THEN
- WRITE( NOUT, FMT = 9999 )INFO, INFOT
- ELSE
- WRITE( NOUT, FMT = 9997 )INFO
- END IF
- OK = .FALSE.
- END IF
- IF( SRNAME.NE.SRNAMT )THEN
- WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
- OK = .FALSE.
- END IF
- RETURN
- *
- 9999 FORMAT( , I6, ,
- $ , I2, )
- 9998 FORMAT( , A6, ,
- $ , A6, )
- 9997 FORMAT( , I6,
- $ )
- *
- * End of XERBLA
- *
- END
|